Iterate thought ALL the (even if grouped) shapes in a sheet / EXCEL VBA

Question

Code below does not account for grouped shapes. Is there a work around?

Sub LoopThruShapes()
   Dim sh As Shape
   i=1
   For Each sh In ActiveSheet.Shapes
      Cells(i, 1).value = sh.name
   Next
End Sub

source: http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/LoopingthroughaCollectionofShapes.htm

Answer 1

You can try this code:

Sub test()
  EnumShapes ActiveSheet.shapes
End Sub

Function EnumShapes(shps As Shapes)
  Dim shp As Shape
  Dim subshp As Shape
  For Each shp In shps
    Debug.Print shp.Name
    If shp.Type = msoGroup Then
      For Each subshp In shp.GroupItems
        Debug.Print Space(2) + subshp.Name
      Next subshp
    End If
  Next shp
End Function

If a grouped shape is itself a group, the code above doesn't identify the subgroups, because Excel flattens the shapes in the GroupItems collection, but it does enumerate all of the shapes (regardless of their depth).

You'll get output like this:

Rectangle 1
Group 4
  Rectangle 2
  Rectangle 3
Group 12
  Rectangle 6
  Rectangle 7
  Rectangle 9
  Rectangle 10