Search code examples
vbagroupingpowerpointshapes

PowerPoint vba group shapes using Shape objects, not shape names


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://learn.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


Solution

  • 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