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

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(或相反)，不需要两个变量。

• 。您可以直接使用PasteHere.Left而不是Cells(PasteRow, 1).Left.

• 。您应该避免使用在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