Powerpoint VBA 选择幻灯片特定区域内的所有形状

Question

我想在 powerpoint 中运行一个允许以下步骤的宏：

1. 对于当前演示文稿中的每张幻灯片，在大小尺寸范围内选择幻灯片的一个区域
2. 对所有对象（形状、文本框等）进行分组，但不要在大小范围内对图像（emf、jpg、png）进行分组
3. 取消组合

我是 ppt vba 的新手。到目前为止，在进行了一些研究之后，我为每张幻灯片上的选定对象创建了一个。

感谢您的帮助！

Public Sub ResizeSelected()
On Error Resume Next
Dim shp As Shape

If ActiveWindow.Selection.Type = ppSelectionNone Then
  MsgBox "select a grouped", vbExclamation, "Make Selection"
Else
  Set shp = ActiveWindow.Selection.ShapeRange(1)

With ActiveWindow.Selection.ShapeRange
 .Width = 12.87
 .Left = 0.23
 .Ungroup
End With
End If
End Sub

Answer 1

您可以自行更改大小、取消组合和显示消息框。这将有助于选择和分组形状。根据您的需要更改传递给 IsWithinRange 的值，如果您愿意，可以向案例选择器添加更多形状类型；我只是添加了一些典型的类型。您肯定要排除占位符、表格等，因为它们不能与其他形状组合在一起。

Sub Thing()
    Dim oSl As Slide
    Dim oSh As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oSh In oSl.Shapes
            If IsWithinRange(oSh, 0, 0, 200, 200) Then
                ' Don't select certain shapes:
                Select Case oSh.Type
                    Case 1, 6, 9
                        ' add the shape to the selection
                        oSh.Select (False)
                    Case Else
                        ' don't include it
                End Select
            End If
        Next
        ActiveWindow.Selection.ShapeRange.Group
    Next
End Sub

Function IsWithinRange(oSh As Shape, _
    sngLeft As Single, sngTop As Single, _
    sngRight As Single, sngBottom As Single) As Boolean
' Is the shape within the coordinates supplied?

    With oSh
        Debug.Print .Left
        Debug.Print .Top
        Debug.Print .Left + .Width
        Debug.Print .Top + .Height
        If .Left > sngLeft Then
            If .Top > sngTop Then
                If .Left + .Width < sngRight Then
                    If .Top + .Height < sngBottom Then
                        IsWithinRange = True
                    End If
                End If
            End If
        End If
    End With

End Function

Answer 2

Dim oSl As Slide
Dim oSh As Shape

For Each oSl In ActivePresentation.Slides
For Each oSh In oSl.Shapes
  If IsWithinRange(oSh, -1, 0.5, 13.5, 7.4) Then
    ' Don't select certain shapes:
    Select Case oSh.Type
    Case msoGroup, msoChart, msoAutoShape, msoLine, msoDiagram, msoEmbeddedOLEObject
  ' add the shape to the selection
    oSh.Select (False)
    Case Else
    ' don't include it
    End Select
   End If
   Next
   ActiveWindow.Selection.ShapeRange.Group.Select

Next oSl
End Sub

Function IsWithinRange(oSh As Shape, _
sngLeft As Single, sngTop As Single, _
sngRight As Single, sngBottom As Single) As Boolean
' Is the shape within the coordinates supplied?

With oSh
    Debug.Print .Left
    Debug.Print .Top
    Debug.Print .Left + .Width
    Debug.Print .Top + .Height
    If .Left > sngLeft Then
        If .Top > sngTop Then
            If .Left + .Width < sngRight Then
                If .Top + .Height < sngBottom Then
                    IsWithinRange = True
                End If
            End If
        End If
    End If
 End With
End Function

Answer 3

记住形状的位置和大小以字体点数（72 pts / inch）给出。如果这些以英寸为单位“IsWithinRange(oSh, -1, 0.5, 13.5, 7.4)”，请尝试 IsWithinRange(oSh, -72, 36, 98, 533)。