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

Answer 2

我也有类似的需求。我想遍历每个Visio形状并更改LockGroup设置和LockTextEdit设置，包括所有子组以及这些组中的子组（无限）。 Visio没有msoGroup或GroupItems，因此我替换了正确的对象元素。我添加了上述示例，并在循环内再次调用了该函数。我喜欢调试打印的缩进，因此我也添加了变量来通过每个子组循环执行此操作。对我来说很棒，希望其他人也觉得它有用。

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

您将获得如下输出以及清除保护锁的信息：

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

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

2 个答案: