如何对幻灯片上的所有对象进行分组，可以分组，并调整组的大小？答案

【问题标题】：How to group all objects on a slide, which can be grouped, and resize the group?如何对幻灯片上的所有对象进行分组，可以分组，并调整组的大小？
【发布时间】：2021-09-08 16:27:12
【问题描述】：

如何将幻灯片上的所有对象（或“形状”？）分组并调整该组的大小？

随后“大”组应该被取消分组。

我的尝试因“预期功能”而失败：

Sub Group_And_Resize()
    Dim Sld As Slide
    With Sld.Shapes
        With .SelectAll.Group   //Error here
            .Width = 907
        End With
    End With
End Sub

通过手动实验，我了解到某些对象（或“形状”？）无法添加到组中，例如自动生成的幻灯片编号。是否有可能将其排除在选择之外？

【问题讨论】：

标签： vba powerpoint

【解决方案1】：

如果您想先将形状组合在一起，然后将整体宽度设置为 907，您可以使用以下代码：

Sub Group_And_Resize()
    Dim Sld As Slide, a As Variant, i As Integer
    
    Set Sld = ActivePresentation.Slides(1)  ' your slide
    
    ReDim a(1 To Sld.Shapes.Count)
    For i = LBound(a) To UBound(a)
        a(i) = Sld.Shapes(i).Name
    Next
    
    Sld.Shapes.Range(a).Group.Width = 907
End Sub

如果想让幻灯片上每个形状的宽度=907，可以使用如下代码：

Sub Group_And_Resize()
    Dim Sld As Slide
    Set Sld = ActivePresentation.Slides(1)  ' your slide
    Sld.Shapes.Range.Width = 907
End Sub

【讨论】：

这有几个问题； 1) 它不排除无法分组的占位符形状。 2）它只设置最终组的宽度，而不是高度，因此组内的形状会变形。根据您的不同版本，请参阅我建议的答案。

【解决方案2】：

这是基于 Алексей Р 的回答，但解决了一些问题，而且更通用。它允许在活动演示文稿中的任何幻灯片上调用例程并将宽度设置为任何所需的值。有关详细信息，请参阅 cmets。

Sub Test()

    With ActivePresentation
        Call Group_And_Resize(.Slides(1), 200)
    End With

End Sub


Sub Group_And_Resize(Sld As Slide, sngWidth As Single)
    Dim a As Variant, i As Long ' Array indices are longs, not integers
    Dim oGroup As Shape
    
    ' Call NonPlaceholderShapeCount to get number of
    ' shapes that are not placeholders, since placeholders
    ' cannot be grouped. Use that to ReDim the array:
    ReDim a(1 To NonPlaceholderShapeCount(Sld))

    For i = LBound(a) To UBound(a)
        ' Again, make sure we don't try to group placeholders
        If Not Sld.Shapes(i).Type = msoPlaceholder Then
            a(i) = Sld.Shapes(i).Name
        End If
    Next
    
    ' Get a reference to the new group
    ' since we need to set several properties on it
    Set oGroup = Sld.Shapes.Range(a).Group
    ' This ensures that the group (and its shapes)
    ' aren't distorted:
    oGroup.LockAspectRatio = True
    ' and finally, set the width
    oGroup.Width = sngWidth
    
End Sub

Function NonPlaceholderShapeCount(Sld As Slide) As Long
' Returns the number of non-placeholder shapes on Sld

    Dim x As Long
    Dim lCount As Long
    
    With Sld
        For x = 1 To .Shapes.Count
            If Not .Shapes(x).Type = msoPlaceholder Then
                lCount = lCount + 1
            End If
        Next
    End With

    NonPlaceholderShapeCount = lCount
    
End Function

【讨论】：