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

Question

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!

Answer 1

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