Access shape group within a group in VBA

Question

I am trying to access a sub-group with a group in VBA (PPTX), NOT all shapes. For example:

Here is my grouping structure

• Group 1
  • Group 2
    • Line 1
    • Rectangle 1
  • Rectangle 2

I want GroupItems.Count to be 2 (one group and one rectangle) instead of 3 (two rectangles and one line)! Obviously GroupItems.Count goes to the lowest level, but what function/property do I need here? How do I access the "next grouping layer" instead of the lowest grouping layer?

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

Answer 1

tl;dr - there is no native solution for this. As Steve pointed out, it looks like a bug.

It looks like there isn't a native Microsoft way to do this, I tried playing with a bunch of shape properties/functions. But I created a solution in case anyone else is interested. First you'll need some context:

• I'm using this code keep track of objects and manipulate them, including re-grouping in different ways
• I basically need to store combinations of shapes into a ShapeRange to make this happen
• That means when I process the objects, I store them first to a string array, then I ungroup, then create a new ShapeRange.
• Ungrouping is key. As it turns out, the only way to solve this problem is to save all of the shapes, sub-shapes, and sub-sub-shapes into a string array, then ungroup, then look at slide and pick up the shapes/groups that contain the original list.
• Going back to my example, this is like making a list of {"Line 1", "Rectangle 1", "Rectangle 2"}, then ungrouping everything, then looking at all objects in the slide, noticing that "Line 1" and "Rectangle 1" are in the original list so adding it's shape object "Group 2" to the list. Also seeing that "Rectangle 2" is in the original list so adding that too. Wow. Inefficient, but it was the best I could come up with.

    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