在 VBA 中访问组内的形状组

我正在尝试访问包含 VBA (PPTX) 中的组的子组，而不是所有形状。例如：

这是我的分组结构

• Group 1
  • Group 2
    • Line 1
    • 长方形1
  • 长方形2

我希望 GroupItems.Count 为 2（一组和一个矩形）而不是 3（两个矩形和一条线）！显然 GroupItems.Count 进入最低级别，但是我在这里需要什么功能/属性？如何访问“下一个分组层”而不是最低分组层？

Dim allShapes As ShapeRange
Dim myShape as Shape
Dim i as Integer

    Set allShapes = ActiveWindow.Selection.ShapeRange
    For Each myShape In allShapes
        If myShape.Type = msoGroup Then
            Debug.Print myShape.GroupItems.Count
            For i = 1 To myShape.GroupItems.Count
                Debug.Print myShape.GroupItems(i).Type
                Debug.Print myShape.GroupItems.Item(i).Name
            Next i
        End If
    Next myShape

tl;dr - 对此没有本地解决方案。正如史蒂夫指出的那样，它看起来像一个错误。

看起来微软没有原生的方法来做到这一点，我尝试使用一堆形状属性/函数。但我创建了一个解决方案，以防其他人感兴趣。首先，您需要一些背景信息：

• 我正在使用此代码跟踪对象并操作它们，包括以不同的方式重新分组
• 我基本上需要将形状组合存储到 ShapeRange 中才能实现这一点
• 这意味着当我处理对象时，我首先将它们存储到字符串数组中，然后取消分组，然后创建一个新的 ShapeRange。
• 取消分组是关键。事实证明，解决这个问题的唯一方法是将所有形状、子形状和子子形状保存到一个字符串数组中，然后取消分组，然后查看幻灯片并选取需要的形状/组。包含原始列表。
• 回到我的示例，这就像制作一个 {“Line 1”、“矩形 1”、“矩形 2”} 列表，然后取消所有内容的分组，然后查看幻灯片中的所有对象，注意“Line 1”和“矩形 1”位于原始列表中，因此将其形状对象“组 2”添加到列表中。还看到“矩形 2”位于原始列表中，因此也将其添加。哇。效率低下，但这是我能想到的最好的。

    Function getParentShapes(shpList() As String, sld As Slide) As Collection
        'Input: array of shape names that may or may not be within a group
        'Output: collection of shape and group names - group names will contain items in input array
        'Output return names of shapes as they are on the slide (grouped or not grouped)
        
        Dim myShape As Shape
        Dim inputShpName As Variant
        Dim subShape As Shape
        Dim countShapes As Integer
        Dim i  As Integer
        Dim found As Boolean
        Dim retList As New Collection
        Dim a As Integer
        Dim aStr As String
        
        countShapes = sld.Shapes.Count
        
        'Loop through all shapes on slide
        For i = 1 To countShapes
            aStr = sld.Shapes(i).Name
            'If this item is a group
            If sld.Shapes(i).Type = msoGroup Then
                'Loop through all grouped items within Shapes(i) to get names
                For Each subShape In sld.Shapes(i).GroupItems
                    'Loop through input shape list to see if it's on the list
                    For Each inputShpName In shpList
                        If inputShpName = subShape.Name Then
                            'Match found - error handling to prevent double adds
                                '(e.g. teo shapes in same group - add group name only once)
                            On Error Resume Next
                            retList.Add aStr, aStr
                            Err.Clear
                            On Error GoTo -1
                            
                        End If
                    Next inputShpName
                Next subShape
            Else
                For Each inputShpName In shpList
                    If inputShpName = aStr Then
                        'Match found - error handling to prevent double adds
                        On Error Resume Next
                        retList.Add aStr, aStr
                        Err.Clear
                        On Error GoTo -1
                    End If
                Next inputShpName
            End If
        Next i
        Set getParentShapes = retList
    End Function