PowerPoint vba group shapes using Shape objects, not shape names

Question

I've written some code that formats text. The code doesn't work if user has put the cursor in a shape that is part of a group of shapes, the solution for which is to ungroup the shapes.

I want to regroup the shapes after executing the formatting code.

I am able to store the underlying shapes as objects, as well as their names. But, the normal approach to grouping (using shape names) doesn't work, because there can be multiple instances of those shape names on a given slide. E.g. this doesn't work as there could be multiple instances of "textbox" on the slide:

Set TempShapeGroup = TempSlide.Shapes.Range(Array("textbox", "header", "separator")).Group

https://docs.microsoft.com/en-us/office/vba/api/powerpoint.shaperange.group

But, I have the shape objects stored in an array, the crux of which is this (the object 'TempShape' is the group of shapes):

Dim ShapesArray()               As Shape
ReDim ShapesArray(1 To TempShape.GroupItems.Count)

For i = 1 To TempShape.GroupItems.Count
    Set ShapesArray(i) = TempShape.GroupItems.Item(i)
Next i

So, what I want to do is recreate the group of shapes, using the array of shape objects, so something to the effect of the below would be ideal:

Set MyShapesGroup= ShapesArray.Group

But any way to group shapes using Shape objects would be fine.

TIA

Btw I have tried the last section of this: stackoverflow.com/questions/57965794/… But same issue arises with having multiple shapes with same name on the slide, hence the need to use the objects, not their names — JakeyG

Steve Rindsberg Steve Rindsberg · Accepted Answer · 2021-05-09T16:46:17

Here's some starter code that you can modify into a function that'll return a reference to the paragraph that contains the current selection cursor. It doesn't really need all the debug.print stuff, of course, but that might help to illustrate the object hierarchy:

Sub WhereIsTheCursor()

Dim oRng As TextRange
Dim oParentRange As TextRange
Dim x As Long
Dim lSelStart As Long
Dim lSelLen As Long

With ActiveWindow.Selection.TextRange
    ' find the selection start relative to first character in shape
    lSelStart = .Start
'    lSelLen = .Length
    
    Debug.Print TypeName(.Parent)
    Debug.Print TypeName(.Parent.Parent)
    Debug.Print TypeName(.Parent.Parent.Parent)
    Debug.Print .Paragraphs.Count
    Set oRng = .Characters(.Start, .Length)
    Debug.Print oRng.Text
    
    ' Reference the overall shape's textrange
    Set oParentRange = .Parent.Parent.TextFrame.TextRange
    
    ' For each paragraph in the range ...
    For x = 1 To oParentRange.Paragraphs.Count
    
        ' is the start of the selection > the start of the paragraph?
        If lSelStart > oParentRange.Paragraphs(x).Start Then
            ' is the start < the start + length of the paragraph?
            If lSelStart < oParentRange.Paragraphs(x).Start _
               + oParentRange.Paragraphs(x).Length Then
               ' bingo!
               MsgBox "The cursor is in paragraph " & CStr(x)
            End If
        End If
    
    Next
    
End With

End Sub

PowerPoint vba group shapes using Shape objects, not shape names

2 Answers