Powerpoint VBA 到 select 幻灯片特定区域内的所有形状

Question

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

对于活动演示文稿中的每张幻灯片，select 大小尺寸
将所有对象（形状、文本框等）分组，但不要将尺寸内的图像（emf、jpg、png）分组
取消组合

我是ppt新手vba。在做了一些研究之后，我在每张幻灯片上为 selected 对象创建了一个。

感谢帮助！

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

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

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 磅/英寸）给出。如果这些以英寸为单位 "IsWithinRange(oSh, -1, 0.5, 13.5, 7.4)," 尝试 IsWithinRange(oSh, -72, 36, 98, 533).

Powerpoint VBA 到 select 幻灯片特定区域内的所有形状

Powerpoint VBA to select all shapes within a specific area of the slide

powerpoint

vba