How to open a new workbook and add images with VBA?

问题

I'm trying to get a macro for Excel 2007to open a folder with a bunch of images in them. Then Create a new workbook and embed the images into it.

Everything works if I comment out the line Sheet.Shapes.AddPicture FileName:=F, linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=cell.Left + 5, Top:=cell.Top + 5, Width:=560, Height:=310 If I uncomment that line I get "Run-time error '434': Object required"

I've check that Sheet.Shapes is returning a Shapes object, it is but the Shapes object is empty. When I try Sheet.Shapes,AddPicture on a workbook that is opened outside of the macro, it adds the images. I've also checked that Sheet.Shapes.AddShape works with the workbook opened in the macro, it does.

At this point, I'm at a lose for what the issue might be. Does anyone have any experience with this sort of thing? Should I be using a different method? Thanks in advance for any help or guidance.

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

回答1:

You can't define a cell by creating the string "C1", that's just the address. The way you did it, cell is a string and a string doesn't have any properties. What you want is a range object so either use

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

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

You should always Dim all variables, use Option Explicit on top of your module so you don't forget it ;)

This will often prevent mistakes. Of course you should Dim them with the correct type, i.e. Dim FilePath As String.

回答2:

The correct command would be:

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

I strongly advise you to change your Name variable name, as it will cause errors on recent versions of excel.

来源：https://stackoverflow.com/questions/40511777/how-to-open-a-new-workbook-and-add-images-with-vba

标签

excel

vba

excel-vba