CODEWITHSUNDEEP
vbapowerpointshapes
user6089076
user6089076

Reputation:

Existence of shapes in Powerpoint

I would like to build a condition on a command button on a Macro enabled powerpoint presentation. If the shape exists then I would like it deleted, otherwise the button should produce a statement about the fact that there is no such shape. Currently I am having trouble with existence...! How do I get Power point to recognise the shape is null? Here is my code:

If ActivePresentation.Slides(3).Shapes("Picture") Is Nothing Then
  MsgBox "no Picture"
Else
  ActivePresentation.Slides(3).Shapes("Picture").Delete
  MsgBox "Picture Cleared"
End If

This code only produces an error because the shape doesn't exist so the first if statement fails. Perhaps we need to check whether its in the selection pane?

Upvotes: 2

Views: 6199

Answers (2)

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

Some of the other suggestions will work but in general, it's bad practice to rely on selection unless absolutely necessary. Instead, you could call a slightly different function:

Function ShapeExists(ByVal oSl as Slide, ByVal ShapeName as String) as Boolean
   Dim oSh as Shape
   For Each oSh in oSl.Shapes
     If oSh.Name = ShapeName Then
        ShapeExists = True
        Exit Function
     End If
   Next ' Shape
   ' No shape here, so though it's not strictly necessary:
   ShapeExists = False
End Function

You could also modify this to return a reference to the shape if found or nothing if not.

If you prefer not to use early Exit Functions, there are easy ways to write around that.

Upvotes: 4

QHarr
QHarr

Reputation: 84465

As @davidmneedham gives in the link in the comments (@TimWilliams answer), you can use a construct similar to as follows:

Option Explicit

Sub test()

Dim shp As Shape
Dim myshapeName As String
myshapeName = "Picture"
Dim sl As Slide

Set sl = ActivePresentation.Slides(1)

 If shapePresent(sl, myshapeName) Then

     sl.Shapes(myshapeName).Delete

 Else

    MsgBox myshapeName & " not present"

 End If

End Sub


Private Function shapePresent(ByVal sl As Slide, ByVal myshapeName As String) As Boolean

   On Error GoTo errhand

   sl.Shapes(myshapeName).Select

   shapePresent = True
   Exit Function

errhand:

shapePresent = False
Err.Clear

End Function

Using the same format as that answer:

Private Function shapePresent(ByVal sl As Slide, ByVal myshapeName As String) As Boolean

    Dim myShape As Shape

    On Error Resume Next

    Set myShape = sl.Shapes(myshapeName)

    On Error GoTo 0

    shapePresent = Not myShape Is Nothing

End Function

Upvotes: 3

Related Questions