用vba插入圖片

Question

我想用VBA插入圖片，但代碼只將圖片鏈接到excel表格。一旦我刪除了圖像，表格中的鏈接圖像被刪除。我需要調整代碼以將鏈接的圖像保存到工作簿中。這是我的代碼有

Sub DeleteImages() 
    For Each s In ActiveSheet.Shapes 
     s.Delete 
    Next s 
    ActiveSheet.Cells.Rows.AutoFit 
End Sub 

Sub AddImages() 
    Dim sImgFile As String 

    sPath = ActiveWorkbook.Path & Application.PathSeparator 

    Set ws = ActiveSheet 
    ltop = Val(InputBox("Provide height", "Height")) 
    'lwid = Val(InputBox("Provide width", "Width")) 

    'On Error GoTo StopIt 
    If ltop > 0 Then 'And lwid > 0 

     ws.Range("E1").ColumnWidth = 1 

     For l = 2 To ws.Range("A" & Rows.Count).End(xlUp).Row 
      ws.Range("A" & l).Rows.AutoFit 
      sImgFile = Dir(sPath & ws.Range("B" & l).Value & ".*") 
      If sImgFile <> "" Then 
       With ws.Pictures.Insert(sPath & sImgFile) 
        With .ShapeRange 
         .LockAspectRatio = msoTrue 
         '.Width = lwid 
         .Height = ltop 
         i = 1 
         ws.Range("E" & l).ColumnWidth = Application.WorksheetFunction.Max(.Width/5.3, ws.Range("E" & l).ColumnWidth) 
         ws.Range("E" & l).RowHeight = .Height + 4 
        End With 
        .Left = ws.Cells(l, 5).Left 
        .Top = ws.Cells(l, 5).Top + 2 
        .Placement = 1 
        .PrintObject = True 
        Call Macro1(Range("E" & l)) 
       End With 
      End If 
     Next l 
    End If 
    For Each s In ActiveSheet.Shapes 
     s.Left = ws.Range("E1").Left + (ws.Range("E1").Width - s.Width)/2 
    Next s 

    StopIt: 
     On Error GoTo 0 
End Sub 

Answer 1

試試這個：

 If sImgFile <> "" Then 
      With ws.Shapes.AddPicture(sPath & sImgFile, linktofile:=msoFalse, _ savewithdocument:=msoCTrue) 
       .LockAspectRatio = msoTrue 
       '.Width = lwid 
       .Height = ltop 
       i = 1 
       ws.Range("E" & l).ColumnWidth = Application.WorksheetFunction.Max(.Width/5.3, ws.Range("E" & l).ColumnWidth) 
       ws.Range("E" & l).RowHeight = .Height + 4 

       .Left = ws.Cells(l, 5).Left 
       .Top = ws.Cells(l, 5).Top + 2 
       .Placement = 1 
       .ControlFormat.PrintObject = True 
       Call Macro1(Range("E" & l)) 
      End With 
     End If