Изменение размера VBA Powerpoint с указанием c имени - PullRequest
0 голосов
/ 10 апреля 2020

Я очень новичок в VBA, надеюсь, это простой вопрос, но я не могу понять его. Мне нужно создать макрос, который изменяет размер и положение фигуры, которая имеет имя c. У меня разные фигуры с одинаковыми именами на разных слайдах, и я хочу, чтобы макрос изменял размер и положение всех фигур с указанным именем c в моей презентации 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

Ответы [ 2 ]

1 голос
/ 10 апреля 2020

В зависимости от поднятых ошибок должен использоваться метод последней инстанции.

Чаще, чем в PowerPoint, вам приходится проверять каждую фигуру на каждом слайде, чтобы найти имя. В этом примере просто добавляется al oop, чтобы сначала проверить имя, затем 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
0 голосов
/ 10 апреля 2020

Вы можете проверить, существует ли ваша форма следующим образом ...

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

End Sub

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...