VBA to Ungroup All PowerPoint Shapes in All Slides - vba

Question

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!

Answer 1

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

Answer 2

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.