Question

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

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

我是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点/英寸）给出。如果这些英寸单位为英寸“ IsWithinRange（oSh，-1，0.5，13.5，7.4）”，请尝试IsWithinRange（oSh，-72，36，98，533）。

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

3 个答案: