VBA如何遍历PowerPoint形状组中直接嵌套的子形状？

问题1：程序崩溃原因及检测方案 #

崩溃的核心原因是未分组的形状不存在ParentGroup属性，你遍历过程中遇到未编入任何组的形状时，直接访问Sh.ParentGroup.Id会触发空引用异常，严重时就会导致VBA环境和PowerPoint进程崩溃。

需要提前检测形状是否属于某个组，检测代码示例如下：

Dim Sh As Shape
' 先判断选中的对象是否是组，避免访问GroupItems出错
If ActiveWindow.Selection.ShapeRange.Type = msoGroup Then
    For Each Sh In ActiveWindow.Selection.ShapeRange.GroupItems
        ' 仅当形状是分组子元素时，才访问ParentGroup属性
        If Sh.Type = msoGroupedShape Then
            Debug.Print Sh.ParentGroup.Id
            ' 你的业务逻辑写在这里
        End If
    Next Sh
End If

问题2：区分三个形状组的替代方案 #

有三种更稳定的方案可选：

• 方案1：手动给组命名。编组后打开PowerPoint「选择窗格」，直接把三个顶层组分别命名为坐标轴组、正值数据组、负值数据组，后续遍历ShapeRange时直接通过Sh.Name属性筛选对应组即可，逻辑最简单不易出错。
• 方案2：给组打自定义标记。给三个顶层组设置Tag属性做标识，比如：

  ' 手动选中对应组后运行这三行分别打标
  ActiveWindow.Selection.ShapeRange(1).Tag = "坐标轴"
  ActiveWindow.Selection.ShapeRange(1).Tag = "正值数据"
  ActiveWindow.Selection.ShapeRange(1).Tag = "负值数据"
  

  后续遍历直接筛选Sh.Tag属性即可，不受组重命名影响。
• 方案3：直接遍历顶层组。你最终生成的三个都是顶层独立组，不需要遍历内部GroupItems，直接遍历选中的所有msoGroup类型的形状就能拿到三个组的引用：

  Dim groupArr(1 To 3) As Shape, idx As Integer
  idx = 1
  For Each Sh In ActiveWindow.Selection.ShapeRange
      If Sh.Type = msoGroup Then
          Set groupArr(idx) = Sh
          idx = idx + 1
      End If
  Next Sh
  ' 后续直接操作groupArr里的三个组即可
  

内容的提问来源于stack exchange，提问作者John Boe