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 

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