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

用vba插入图片

1 个答案: