VBA: runtime error '424' Object required when searching for Shape

Question

I created a VBA script to transfer data from Excel to PowerPoint (both Version 2016) and want to check if there exists a specific Shape on Slide x and then copy it to Slide y.

The common solution which is also mentioned in (Existence of shapes in Powerpoint) does produce

"runtime error '424': Object required"

in line 3 of the function at For Each oSh in myPresentation.Slides(4).Shape

Function ShapeExists(ByVal ShapeName as String) as Boolean

Dim oSh as Shape

For Each oSh in myPresentation.Slides(4).Shapes
     If oSh.Name = ShapeName Then
        ShapeExists = True
        Exit Function
     End If
Next
End Function

The code where "ShapeExists" is called:

Set PowerPointApp = GetObject(class:="PowerPoint.Application")
Set myPresentation = PowerPointApp.Presentations.Add

 If ShapeExists("MSDreieck2") Then
    myPresentation.Slides(4).Shapes("MSDreieck2").Copy
    mySlide5.Shapes.PasteSpecial DataType:=0
 Else
    GoTo NACHZEITSTRAHLCOPY:
 End If

I already added the Object Library for Powerpoint 2016 under references and several others. When typing dim oSh as Shape it suggests two different "Shape" items in the list (one for Excel, one for PP) but it doesn't make a difference for the error which one I use.

As far as I'm concerned there is no other way to check if a specific Shape exists as the Shape index gets newly assigned at every run and as the number of Shapes on Slide x is not always the same in my case.

I would be very grateful for every suggestion. Thanks

Answer 1

Since it is available in both Excel and Powerpoint, avoid confusing the code by explicitly declaring it :)

Dim oSh As PowerPoint.Shape

or

Dim oSh As Object

If you do not explicitly declare it, it will refer to the Object from the Native Application which is Excel in this case. Object does late binding and leaves the Application to decide at runtime.

EDIT

A basic example on how to achieve what you want using LATE BINDING (The below code is Untested). Let me know if you get any errors.

Option Explicit

Dim PowerPointApp As Object
Dim myPresentation As Object
Dim oPPSlide As Object

Sub Sample()       
    '~~> Establish an PowerPoint application object
    On Error Resume Next
    Set PowerPointApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
    
    If PowerPointApp Is Nothing Then
        MsgBox "No Powerpoint Instance found"
        Exit Sub
    End If
    
    PowerPointApp.Visible = True
    
    '~~> Work with open Presentation1
    Set myPresentation = PowerPointApp.Presentations("Presentation1")
    
    '~~> Change this to the relevant slide which has the shape
    Set oPPSlide = myPresentation.Slides(4)
    
    If ShapeExists("MSDreieck2") Then
        '
        '~~> Rest of your code
        '
    End If
End Sub


Function ShapeExists(ByVal ShapeName As String) As Boolean
    Dim oSh As Object
    
    For Each oSh In oPPSlide.Shapes
      If oSh.Name = ShapeName Then
         ShapeExists = True
         Exit Function
      End If
    Next
End Function