Excel VBA – 在工作表中插入批量图像

我使用低于VBA代码获取图像在Excel表中，但此代码添加图片作为链接，所以当我发送表另一台PC的人得到的图像位置找不到错误。

我怎样才能添加图片而不是链接的图像？

Sub AddOlEObject() Dim mainWorkBook As Workbook Set mainWorkBook = ActiveWorkbook Sheets("Object").Activate Folderpath = "C:\phoenix" Set fso = CreateObject("Scripting.FileSystemObject") NoOfFiles = fso.GetFolder(Folderpath).Files.Count Set listfiles = fso.GetFolder(Folderpath).Files For Each fls In listfiles strCompFilePath = Folderpath & "\" & Trim(fls.name) If strCompFilePath <> "" Then If (InStr(1, strCompFilePath, ".jpg", vbTextCompare) > 1) Then counter = counter + 1 Sheets("Object").Range("A" & counter).Value = fls.name Sheets("Object").Range("B" & counter).ColumnWidth = 50 Sheets("Object").Range("B" & counter).RowHeight = 150 Sheets("Object").Range("B" & counter).Activate Call insert(strCompFilePath, counter) Sheets("Object").Activate End If End If Next End Sub Function insert(PicPath, counter) 'MsgBox PicPath With ActiveSheet.Pictures.insert(PicPath) With .ShapeRange .LockAspectRatio = msoTrue .Width = 100 .Height = 150 End With .Left = ActiveSheet.Range("B" & counter).Left .Top = ActiveSheet.Range("B" & counter).Top .Placement = 1 .PrintObject = True End With End Function 

Answer 1

该图像是您保存在经常使用的个人目录中的单个图像吗？ 也是保存为.JPEG的图像？

你为什么不使用下面的简单的VBA代码？

 Sub CALLPICTURE() Worksheets("SHEET1").Shapes.AddPicture Filename:="I:\Control\DECOMP\ Images\Zebra.jpg", linktofile:=msoFalse, _ savewithdocument:=msoCTrue, Left:=0, Top:=0, Width:=632, Height:=136 End Sub 

您可以添加尽可能多的图像，只要你想。