VBA macro does not iterate over all cells when inserting pictures-CodePudding

I'm currently trying to write a VBA macro for MS Word. The job is to iterate over selected cells of a table and to replace the filepath written there with the picture it points to.

The macro works fine when only one cell is selected or if all selected cells are in the same column. However, when cells from more than one columns are selected, only the left most column gets processed.

Here is the code:

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

Interesting: When I do that:

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

... it iterates over every cell in the selection.

Can anyone tell me where I messed things up? :-D Thanks in advance!

CodePudding user response：

Please, try the next way:

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