VBA插入图片时宏没有遍历所有单元格

Question

我目前正在尝试为 MS Word 编写 VBA 宏。工作是遍历 table 的选定单元格，并用它指向的图片替换写在那里的文件路径。

当只选择一个单元格或所有选定的单元格都在同一列时，宏可以正常工作。但是，如果选择了多个列中的单元格，则只会处理最左边的列。

代码如下：

Dim photoCells As Cells
Set photoCells = Selection.Cells

For Each photoCell In photoCells

    Dim filePath As String
    filePath = photoCell.Range.Text
    filePath = Left(filePath, Len(filePath) - 2)
    photoCell.Range.Text = ""
    
    Dim shape
    Set shape = photoCell.Range.InlineShapes.AddPicture(filePath)
    
    With shape
        .LockAspectRatio = msoTrue
        .Width = photoCell.PreferredWidth
    End With
    
Next

MsgBox "Completed."

End Sub

有趣：当我这样做时：

For Each mCell in Selection.Cells
    MsgBox mCell.Range.Text
Next

...它遍历选择中的每个单元格。

谁能告诉我哪里搞砸了？ :-D 提前致谢！

Answer 1

请尝试下一种方式：

Sub InsertPictures()
 Dim photoCells As Cells, photoCell, arrPh() As Cell, i As Long
 Dim filePath As String, shape As InlineShape

 Set photoCells = Selection.Cells
 ReDim arrPh(1 To photoCells.Count)
 For i = 1 To photoCells.Count 'place selected cells in a cells array
    Set arrPh(i) = photoCells(i)
 Next

  For i = 1 To UBound(arrPh) 'iterate between the array cell elements
        filePath = arrPh(i).Range.Text
        filePath = Left(filePath, Len(filePath) - 2)
        If Dir(filePath) <> "" Then 'check if file path exists
            arrPh(i).Range.Text = ""
            With arrPh(i).Range.InlineShapes.AddPicture(filePath)
                .LockAspectRatio = msoTrue
                .Width = arrPh(i).PreferredWidth
            End With
        End If
  Next i
 MsgBox "Completed."
End Sub

VBA插入图片时宏没有遍历所有单元格

VBA macro does not iterate over all cells when inserting pictures

vba

ms-word