VBA Powerpoint 调整具有特定名称的形状

Question

我是 VBA 的初学者，我希望这是一个简单的问题，但我无法弄清楚。我需要创建一个宏来更改具有特定名称的形状的大小和位置。我在不同的幻灯片中使用了相同名称的不同形状，我希望宏可以更改我的 PowerPoint 演示文稿中具有该特定名称的所有形状的大小和位置。我想出了这个代码，但是（当然）当它发现一个幻灯片时卡住了，这个幻灯片在这个例子中不包含任何名为“X”的形状。

谢谢

Sub Resize_X()

Dim oSl As slide
Dim Obj As Object
Dim Obj_Left As Long
Dim Obj_Top As Long
Dim Obj_Height As Long
Dim Obj_Width As Long

For Each oSl In ActivePresentation.Slides
Set Obj = oSl.Shapes("X")

    With ActivePresentation.PageSetup
        Obj_Left = Obj.Left
        Obj_Top = Obj.Top
        Obj_Height = Obj.Height
        Obj_Width = Obj.Width
        Obj.LockAspectRatio = True
        Obj.Width = 28.3464567 * 25
            Obj.Left = (.SlideWidth \ 2) - (Obj.Width \ 2)

            Obj.Top = (.SlideHeight \ 2) - (Obj.Height \ 2)

    End With
    Next oSl
End Sub

Answer 1

您可以通过以下方式测试您的形状是否存在...

On Error Resume Next
Set Obj = oSl.Shapes("X")
On Error GoTo 0
If Not Obj Is Nothing Then
   'etc
   '
   '
end if

其实你的宏可以改写如下...

Sub Resize_X()

Dim oSl As Slide
Dim Obj As Object

For Each oSl In ActivePresentation.Slides
    On Error Resume Next
    Set Obj = oSl.Shapes("X")
    On Error GoTo 0
    If Not Obj Is Nothing Then
        Obj.LockAspectRatio = True
        Obj.Width = 28.3464567 * 25
        With ActivePresentation.PageSetup
            Obj.Left = (.SlideWidth \ 2) - (Obj.Width \ 2)
            Obj.Top = (.SlideHeight \ 2) - (Obj.Height \ 2)
        End With
    End If
Next oSl

结束子

Answer 2

根据引发的错误应该是最后的手段。

更常见的是，在 PowerPoint 中，您必须检查每张幻灯片上的每个形状才能找到名称。这个例子只是添加了一个循环来首先检查名称，然后是一个 If...Then 到运行代码：

Sub Resize_X()

Dim oSl As Slide
Dim Obj As Object
Dim Obj_Left As Long
Dim Obj_Top As Long
Dim Obj_Height As Long
Dim Obj_Width As Long
Dim oShape As Shape

    For Each oSl In ActivePresentation.Slides
        For Each oShape In oSl.Shapes  'Check the name of each shape
            If oShape.Name = "X" Then  'If it's found, then run the code
                Set Obj = oSl.Shapes("X")

                With ActivePresentation.PageSetup
                    Obj_Left = Obj.Left
                    Obj_Top = Obj.Top
                    Obj_Height = Obj.Height
                    Obj_Width = Obj.Width
                    Obj.LockAspectRatio = True
                    Obj.Width = 28.3464567 * 25
                        Obj.Left = (.SlideWidth \ 2) - (Obj.Width \ 2)

                        Obj.Top = (.SlideHeight \ 2) - (Obj.Height \ 2)
                End With
            End If
        Next oShape
    Next oSl
End Sub

VBA Powerpoint 调整具有特定名称的形状

VBA Powerpoint resizing shapes with specific name

powerpoint

vba

shapes