CODEWITHSUNDEEP
excelvbaiterationshapes
BuckTurgidson
BuckTurgidson

Reputation: 299

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

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

Upvotes: 2

Views: 9515

Answers (2)

Bart M
Bart M

Reputation: 1

I had a similar need. I wanted to step through every Visio shape and change the LockGroup setting and the LockTextEdit setting, including all subgroups, and subgroups within those groups (to infinitude). Visio did not have msoGroup or GroupItems, so i substituted the correct object elements. I added to the above sample, and called the function again within the loop. I liked your indenting of the debug print, so I added variables to do this through each subgroup loop too. Works great for me, hope someone else finds it useful for other things too.

Sub test()
  Dim i As Integer
  Dim j As Integer
  EnumShapes Visio.ActivePage.shapes, 0

End Sub

Function EnumShapes(shps As shapes, i)
  Dim shp As Shape
  Dim LockGroup As Integer
  Dim LockText As Integer
  Dim celObj As Visio.Cell

    For Each shp In shps
    Set celObj = shp.CellsSRC(Visio.visSectionObject, visRowLock, visLockTextEdit)
    celObj.Formula = 0
    Set celObj = shp.CellsSRC(Visio.visSectionObject, visRowLock, visLockGroup)
    celObj.Formula = 0

    LockGroup = shp.CellsSRC(Visio.visSectionObject, visRowLock, visLockGroup).Result(Visio.visNone)
    LockText = shp.CellsSRC(Visio.visSectionObject, visRowLock, visLockTextEdit).Result(Visio.visNone)
    Debug.Print Space(i + j) + shp.Name; "LockTxT-"; LockText; "LockGrp-"; LockGroup

    If shp.Type = 2 Then
      j = j + 1
      EnumShapes shp.shapes, i + j
    End If
    j = 0
  Next shp
End Function

You'll get output like this as well as it clearing the protection locks:

Rectangle 1 LockTxt-0 LockGrp-0
Group 4 LockTxt-0 LockGrp-0
 Rectangle 2 LockTxt-0 LockGrp-0
 Rectangle 3 LockTxt-0 LockGrp-0
 Group 12 LockTxt-0 LockGrp-0
  Rectangle 6 LockTxt-0 LockGrp-0
  Rectangle 7 LockTxt-0 LockGrp-0
  Group 13 LockTxt-0 LockGrp-0
   Rectangle 9 LockTxt-0 LockGrp-0
   Rectangle 10 LockTxt-0 LockGrp-0
Rectangle 11 LockTxt-0 LockGrp-0
Group 14 LockTxt-0 LockGrp-0
 Rectangle 15 LockTxt-0 LockGrp-0
 Group 16 LockTxt-0 LockGrp-0
  Rectangle 17 LockTxt-0 LockGrp-0
  Rectangle 18 LockTxt-0 LockGrp-0

Upvotes: 0

ThunderFrame
ThunderFrame

Reputation: 9471

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

Upvotes: 11

Related Questions