VBA 取消组合所有幻灯片中的所有 PowerPoint 形状答案

【问题标题】：VBA to Ungroup All PowerPoint Shapes in All SlidesVBA 取消组合所有幻灯片中的所有 PowerPoint 形状
【发布时间】：2016-07-22 17:15:38
【问题描述】：

不幸的是，我有一个宏跳过了 PowerPoint 中需要对文本进行规范化的所有分组形状（硬返回与空格交换）。现在，我编写了一个“准备”脚本，它应该找到所有带有文本的形状并将它们取消组合。由于某种原因，它不起作用。这应该很简单，但我无法让它工作。请帮忙！

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

谢谢！

【问题讨论】：

标签： vba macros powerpoint

【解决方案1】：

我知道这是一篇旧帖子，但我需要一个功能来取消对 PowerPoint 中的每个组的分组，而不管上面提到的动画问题。当检测到一组时，我使用以下内容继续循环遍历幻灯片对象。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

【讨论】：

【解决方案2】：

组没有 TextFrame，因此您正在测试永远不会发生的事情。

If oshp.Type = msoGroup then oshp.Ungroup

应该为简单的分组这样做。但是取消分组可能会产生不必要的副作用（例如，破坏组形状上的任何动画）。而且通常没有必要。考虑：

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

这仍然会给您留下组内组（组内（组内））等可能出现的问题。有办法解决这个问题，但如果它没有损坏，我们不需要修复它。

【讨论】：