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

Posted 2023-02-24

【中文标题】Powerpoint VBA 选择幻灯片特定区域内的所有形状

【英文标题】：Powerpoint VBA to select all shapes within a specific area of the slide

【发布时间】：2018-01-12 04:23:48

【问题描述】：

我想在 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

【参考方案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

【讨论】：

谢谢史蒂夫，我是一个新手，我需要更多地研究你的代码才能完全理解它。我不知道的是上面的案例选择器。什么是案例 1、6、9？你能举个例子在这个案例选择器中包含形状和图表吗？ IsWithinRange 的形状坐标也是从左上角 .left=0.23*7 和 .top=0.54 选择 Height= 6.81in 和 width= 10in。我需要用这个坐标在代码中添加任何东西吗？谢谢

1、6 和 9 是形状的 .Type 属性。在 VBA IDE 中，按 F2 打开对象浏览器，然后搜索 msoShapeType 以获取成员列表。单击每个以查看其 .Type 值。在包含任何形状之前，我会确保您可以手动将它们与另一个形状（如矩形）进行分组；你不能对一些形状进行分组。我不明白你关于坐标的问题；对不起。你能再试一次吗？

【参考方案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

【讨论】：

删除或注释掉 On Error Resume Next。这将掩盖此处发生的任何错误，但为了调试您想知道它们发生在哪里的代码。

虽然它不向用户公开，但一些使用 XML 的聪明人可以修改 PPTX 以锁定特定形状，使其无法被选中。听起来好像您遇到了其中的一个或多个。我会在 osh.Select 之前放置 On Error Resume Next 并在之后立即放置 On Error Resume 0。

感谢您的建议。我仍然没有看到为什么此代码不能应用于下一张幻灯片的任何问题。看起来第一个“下一个”已经应用于“ActiveWindow.Selection.ShapeRange.Group.Select”，这就是为什么它不会推进？如果是这种情况，我可以改变什么来完成这项工作？

您是否按照建议删除了 On Error Resume Next？如果没有，您将无法调试它。

【参考方案3】：

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