在 Mac 上使用 VBA 插入和调整图片大小答案

【问题标题】：Insert and resize a picture with VBA on Mac在 Mac 上使用 VBA 插入和调整图片大小
【发布时间】：2020-07-01 16:31:35
【问题描述】：

我正在尝试运行 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

【问题讨论】：

您检查文件名是否正确？ /macro 是存储文件的文件夹吗？在这种情况下，您在连接 pictname 之前缺少 /
顺便说一句：告诉哪一行引发错误总是一个好主意。
嗨，对不起，我在原帖中不清楚。是的 /Macro 是文件夹。导致错误的行在下面突出显示：ActiveSheet.Pictures.Insert("/Users/name/Desktop/macro" & pictname & ".JPG").Select

标签： excel vba macos image automation

【解决方案1】：

请注意……

...如果你定义Set PasteHere = Cells(x, 1)，那么PasteHere.Row是总是x所以如果你定义PasteRow = PasteHere.Row那么x和PasteRow总是相同的PasteRow 中的您始终可以使用 x（或相反），并且不需要两个变量。
……你可以直接用PasteHere.Left代替Cells(PasteRow, 1).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

【讨论】：