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

Question

我使用下面的vba代码来获取Excel表中的图像，但是此代码在图纸中添加图像作为链接，因此当我将工作表发送到另一台个人电脑时，图像位置未找到错误。

如何添加附加图片而不是图片链接？

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 

你可以添加任意多的图片，只要你想。