multiple objects in single cell

[alenhart]

So I have a macro that renames images in the sheet based on their
topleftcell property. and it works perfectly, except where there are
mulitple images in the same cell. the problem comes when I cannot find
those multiple images.
Someone along the way helped me with this code:

Sub FindImages()
Dim Shp As Shape
Dim Msg As String
For Each Shp In ActiveSheet.Shapes
Msg = Msg & Shp.Name & vbTab & Shp.TopLeftCell.Address(False, False) &
vbLf
Next Shp
MsgBox Msg
End Sub

but the results get posted in a msg box and I need them to go into a
new sheet so I can scroll through the hundreds of them and find which
one is causing my pain.

Can someone help me do that, or give me a better idea of finding where
the mulitple images exist?

thank you.
Anne

 

[Dave Peterson]

Maybe reporting to a new worksheet would be better???

Sub FindImages()
Dim Shp As Shape
dim CurWks as worksheet
dim RptWks as worksheet
dim oRow as long

set curwks = activesheet
set rptwks = worksheets.add
orow = 1

For Each Shp In curwks.Shapes
rptwks.cells(orow,"A").value = shp.name
rptwks.cells(orow,"B").value = shp.topleftcell.address(0,0)
'rptwks.cells(orow,"C").value = shp.bottomrightcell.address(0,0)
orow = orow + 1
Next Shp
End Sub