Question

我正在尝试运行VBA代码，以便使用特定的引用（.jpg名称和用Excel编写的名称）自动插入图像。我使用的是Mac，并不断收到错误消息：

运行时错误'1004'

如果有人可以提供帮助，我将下面使用的代码包括在内：

Sub Picture()      
    Dim pictname As String
    Dim pastehere As Range
    Dim pasterow As Long
    Dim x As Long
    Dim lastrow As Long

    lastrow = Worksheets("sheet1").Range("B1").CurrentRegion.Rows.Count
    x = 2
    For x = 2 To lastrow
        Set pastehere = Cells(x, 1)
        pasterow = pastehere.Row
        Cells(pasterow, 1).Select 

        pictname = Cells(x, 2) 'This is the picture name
        ActiveSheet.Pictures.Insert("/Users/name/Desktop/macro" & pictname & ".JPG").Select 

        With Selection
            .Left = Cells(pasterow, 1).Left
            .Top = Cells(pasterow, 1).Top
            .ShapeRange.LockAspectRatio = msoFalse

            .ShapeRange.Height = 80#
            .ShapeRange.Width = 80#
            .ShapeRange.Rotation = 0#
        End With
    Next
End Sub

Answer 1

请注意...

...如果您定义Set PasteHere = Cells(x, 1)，则PasteHere.Row总是 x，因此，如果您定义PasteRow = PasteHere.Row，则x和PasteRow始终相同，除了PasteRow之外，您还可以始终使用x（或者反过来），并且不需要两个变量。
...您可以直接使用Cells(PasteRow, 1).Left代替PasteHere.Left。
...，您应该avoid using Select in Excel VBA并为所有单元格/范围引用工作表。
…我不会使用Picture作为过程名称，因为这可能会导致与现有属性混淆。

Public Sub InsertPictures()      
    Dim PictName As String
    Dim PictFullPath As String
    Dim PasteHere As Range
    Dim PasteRow As Long
    Dim LastRow As Long

    Dim ws As Worksheet 'define worksheet and use it for all cells!
    Set ws = ThisWorkbook.Worksheets("sheet1")

    LastRow = ws.Range("B1").CurrentRegion.Rows.Count

    For PasteRow = 2 To LastRow 
        Set PasteHere = ws.Cells(PasteRow, 1)

        PictName = ws.Cells(PasteRow, 2).Value 'This is the picture name
        PictFullPath = "/Users/name/Desktop/macro/" & PictName & ".JPG" 'make sure your path ends with a /

        'test if picture exists before using it
        If FileOrFolderExistsOnMac(PictFullPath) Then
            With PasteHere.Pictures.Insert(PictFullPath)
                .Left = PasteHere .Left
                .Top = PasteHere .Top
                .ShapeRange.LockAspectRatio = msoFalse

                .ShapeRange.Height = 80#
                .ShapeRange.Width = 80#
                .ShapeRange.Rotation = 0#
            End With
        Else
            MsgBox "File '" & PictFullPath & "' was not found."
        End If
    Next PasteRow 
End Sub

用于测试文件或文件夹是否存在的功能：

Function FileOrFolderExistsOnMac(FileOrFolderstr As String) As Boolean
'Ron de Bruin : 26-June-2015
'Function to test whether a file or folder exist on a Mac in office 2011 and up
'Uses AppleScript to avoid the problem with long names in Office 2011,
'limit is max 32 characters including the extension in 2011.
    Dim ScriptToCheckFileFolder As String
    Dim TestStr As String

    If Val(Application.Version) < 15 Then
        ScriptToCheckFileFolder = "tell application " & Chr(34) & "System Events" & Chr(34) & _
         "to return exists disk item (" & Chr(34) & FileOrFolderstr & Chr(34) & " as string)"
        FileOrFolderExistsOnMac = MacScript(ScriptToCheckFileFolder)
    Else
        On Error Resume Next
        TestStr = Dir(FileOrFolderstr, vbDirectory)
        On Error GoTo 0
        If Not TestStr = vbNullString Then FileOrFolderExistsOnMac = True
    End If
End Function

* 来源：https://www.rondebruin.nl/mac/mac008.htm

在Mac上使用VBA插入图片并调整图片大小

1 个答案: