0
votes

I am a very beginner with VBA, I hope this is a simple question but I can’t figure it out. I need to create a macro which changes the size and the position of a shape which has a specific name. I have different shapes named the same in different slides, and I want that the macro changes the size and the position of all the shapes with that specific name in my powerpoint presentation. I came up with this code but (of course) it gets stuck when it finds a slide which does not include any shapes named “X” in this example.

Thanks

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

2 Answers

0
votes

You can test whether your shape exists as follows...

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

Actually, your macro can be re-written as follows...

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

1
votes

Depending on raised errors should be a method of last resort.

More often that not in PowerPoint, you have to check each shape on each slide to find the name. This example just adds a loop to check the name first, then an If...Then to run the code:

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