Question

我使用下面的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

您可以根据需要添加任意数量的图片。

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

1 个答案: