在工作表/ EXCEL VBA中迭代所有（即使已分组）形状

Question

下面的代码不考虑分组的形状。有工作吗？

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

来源：http://www.java2s.com/Code/VBA-Excel-Access-Word/Excel/LoopingthroughaCollectionofShapes.htm

Answer 1

你可以试试这段代码：

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

如果分组的形状本身就是一个组，则上面的代码不会识别子组，因为Excel会展开GroupItems集合中的形状，但它会枚举所有形状（无论其深度如何）。

你会得到这样的输出：

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