CODEWITHSUNDEEP
vbamacrospowerpoint
Elijah
Elijah

Reputation: 31

VBA to Ungroup All PowerPoint Shapes in All Slides

I have a macros that is unfortunately skipping all grouped shapes in PowerPoint where the text requires to be normalized (hard returns swapped with spacemarks). Now, I wrote a 'prepping' script that should find all shapes with text and ungroup those. For some reason it is not working. This should be so simple, yet I cannot get it to work. Please help!

Sub Ungroupallshapes()
    Dim osld As Slide
    Dim oshp As Shape
    For Each osld In ActivePresentation.Slides
        For Each oshp In osld.Shapes
            If oshp.Type = msoGroup Then
                If oshp.HasTextFrame Then
                    If oshp.TextFrame.HasText Then oshp.Ungroup
                    End If
                End If
        Next oshp
    Next osld
End Sub

Thank you!

Upvotes: 1

Views: 2779

Answers (2)

Dean
Dean

Reputation: 421

I know this is an old post, but I needed a function to ungroup every group in a PowerPoint regardless of issues with animations as mentioned above. I used the following to continue looping through the slide objects while there was a group detected.Sub 

Sub Shapes_UnGroup_All()
Dim sld         As Slide
Dim shp                                       As Shape
Dim intCount        As Integer
intCount = 0
Dim groupsExist As Boolean: groupsExist = True
If MsgBox("Are you sure you want To ungroup every level of grouping On every slide?", (vbYesNo + vbQuestion), "Ungroup Everything?") = vbYes Then
    For Each sld In ActivePresentation.Slides        ' iterate slides
       Debug.Print "slide " & sld.SlideNumber
       Do While (groupsExist = True)
            groupsExist = False
            For Each shp In sld.Shapes
                If shp.Type = msoGroup Then
                    shp.Ungroup
                    intCount = intCount + 1
                    groupsExist = True
                End If
            Next shp
        Loop
        groupsExist = True
        Next sld
    End If
    MsgBox "All Done " & intCount & " groups are now ungrouped."
End Sub

Upvotes: 2

Steve Rindsberg
Steve Rindsberg

Reputation: 14810

Groups don't have TextFrames, so you're testing for something that will never happen. 

If oshp.Type = msoGroup then oshp.Ungroup

should do it for simple groupings. But ungrouping can have unwanted side effects (blows away any animation on the group shape, for example). And it's not usually necessary. Consider:

Sub ChangeTheText()

    Dim oshp As Shape
    Dim oSld As Slide
    Dim x As Long

    For Each oSld In ActivePresentation.Slides
        For Each oshp In oSld.Shapes
            If oshp.HasTextFrame Then
                oshp.TextFrame.TextRange.Text = "Ha! Found you!"
            Else
                If oshp.Type = msoGroup Then
                    For x = 1 To oshp.GroupItems.Count
                        If oshp.GroupItems(x).HasTextFrame Then
                            oshp.GroupItems(x).TextFrame.TextRange.Text _
                                = "And you too, you slippery little devil!"
                        End If
                    Next
                End If
            End If
        Next
    Next
End Sub

That still leaves you with the possible problem of groups within groups (within groups (within groups)) etc. There are ways around that, but if it ain't broke, we don't need to fix it.

Upvotes: 1

Related Questions