如何使用VBA打开新工作簿并添加图像？

Question

我正在尝试获取Excel 2007的宏以打开其中包含一堆图像的文件夹。 然后创建一个新的工作簿并将图像嵌入其中。

如果我注释掉Sheet.Shapes.AddPicture FileName:=F, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=cell.Left + 5, Top:=cell.Top + 5, Width:=560, Height:=310行，一切正常， Sheet.Shapes.AddPicture FileName:=F, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=cell.Left + 5, Top:=cell.Top + 5, Width:=560, Height:=310如果取消注释该行，则会收到“运行时错误'434'：必需对象”

我检查了Sheet.Shapes是否返回一个Shapes对象，但是Shapes对象为空。 当我尝试在宏外部打开的工作簿上使用Sheet.Shapes，AddPicture时，它会添加图像。 我还检查了Sheet.Shapes.AddShape是否可以在宏中打开的工作簿正常工作。

在这一点上，我对可能出现的问题不知所措。 有人对这种事情有经验吗？ 我应该使用其他方法吗？ 在此先感谢您的帮助或指导。

Sub Macro1()
Dim ImagePath, Flist
ImagePath = GetFolder()
If ImagePath = "" Then Exit Sub
Flist = FileList(ImagePath)
Name = "C:\target.xlsm"
Set Book = Workbooks.Add
Set Sheet = Book.Sheets(1)
For i = 1 To 5
    cell = "C" + CStr(i)
    F = ImagePath + "\" + Flist(i - 1)
        Sheet.Shapes.AddPicture FileName:=F, linktofile:=msoFalse, _
            savewithdocument:=msoCTrue, Left:=cell.Left + 5, Top:=cell.Top + 5, Width:=560, Height:=310
    Next
Book.SaveAs FileName:=Name, FileFormat:=52
Book.Close
End Sub

 Function FileList(ByVal fldr As String) As Variant
'Lists all the files in the current directory
'Found at http://www.ozgrid.com/forum/showthread.php?t=71409
    Dim sTemp As String, sHldr As String
    If Right$(fldr, 1) <> "\" Then fldr = fldr & "\"
    sTemp = Dir(fldr & "*.png")
    If sTemp = "" Then
        FileList = False
        Exit Function
    End If
    Do
        sHldr = Dir
        If sHldr = "" Then Exit Do
        sTemp = sTemp & "|" & sHldr
    Loop
    FileList = Split(sTemp, "|")
End Function

Function GetFolder() As String
Folder:
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Title = "New Screenshot Folder"
    .Show
    num = .SelectedItems.Count
    If .SelectedItems.Count = 0 Then
        GetFolder = ""
    Else: GetFolder = .SelectedItems(1)
    End If
End With
End Function

Answer 1

您无法通过创建字符串“ C1”来定义单元格，而这只是地址。 您的操作方式是， cell是一个字符串，并且字符串没有任何属性。 您想要的是一个范围对象，因此可以使用

Dim cell As Range
Set cell = sheet.Range("C" & i)

要么

Dim cell As Range
Set cell = sheet.Cells(i, 3)

您应该始终使所有变量Dim ，在模块顶部使用Option Explicit ，以免忘记它；）

这通常可以防止错误。 当然，应该在Dim正确类型，即他们Dim FilePath As String 。

Answer 2

正确的命令是：

        Sheet.Shapes.AddPicture Filename:=F, linktofile:=msoFalse, _
        savewithdocument:=msoCTrue, Left:=Range(cell).Left + 5, Top:=Range(cell).Top + 5, Width:=560, Height:=310

我强烈建议您更改Name变量名称，因为这会在最新版本的excel中引起错误。