在Mac上使用VBA插入图片并调整图片大小 [英] Insert and resize a picture with VBA on Mac

问题描述

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

I'm trying to run a VBA Code in order to insert images automatically using a particular reference (name of .jpg and name written on Excel). I'm using a Mac and keep getting the error:

运行时错误'1004'

Run-time error'1004'

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

If anyone can help, I've included the code I'm using below:

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

推荐答案

请注意...

• ...如果定义Set PasteHere = Cells(x, 1)，则PasteHere.Row总是 x，因此，如果定义PasteRow = PasteHere.Row，则x和PasteRow始终相同，而是在PasteRow中，您始终可以使用x(或者相反)，并且不需要两个变量.

• … if you define Set PasteHere = Cells(x, 1) then PasteHere.Row is always x so if you define PasteRow = PasteHere.Row then x and PasteRow are always the same and instead of PasteRow you can always use x (or the other way round) and don't need two variables for that.

...代替Cells(PasteRow, 1).Left，您可以直接使用PasteHere.Left.

… instead of Cells(PasteRow, 1).Left you can directly use PasteHere.Left.

...…您应避免在Excel VBA中使用选择" ，并参考工作表中的所有单元格/范围.

… you should avoid using Select in Excel VBA and reference your worksheet for all cells/ranges.

…我不会使用Picture作为过程名称，因为这可能导致与现有属性混淆.

… that I woud not use Picture as procedure name as this could cause confusings with existing properties.

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 to test if file or folder exists:

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插入图片并调整图片大小的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！