VBA: ошибка времени выполнения '424' Требуется объект при поиске фигуры

Question

Я создал сценарий VBA для передачи данных из Excel в PowerPoint (обе версии 2016) и хочу проверить, существует ли указанная c форма на слайде x, а затем скопировать его в слайд y.

Общее решение, которое также упоминается в ( Существование фигур в Powerpoint ), выдает

"ошибка времени выполнения" 424 ": требуется объект"

в строке 3 функции на 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

Код, где вызывается ShapeExists:

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

Я уже добавил библиотеку объектов для Powerpoint 2016 под ссылками и несколько других. При вводе dim oSh as Shape он предлагает два различных элемента «Shape» в списке (один для Excel, один для PP), но не имеет значения для ошибки, которую я использую.

Насколько Я обеспокоен тем, что нет другого способа проверить, существует ли конкретный c Shape, поскольку индекс Shape заново назначается при каждом запуске, и поскольку число Shapes на слайде x не всегда одинаково в моем случае.

Буду очень признателен за каждое предложение. Спасибо

Answer 1

Поскольку он доступен как в Excel, так и в Powerpoint, избегайте путаницы кода, явно объявив его:)

Dim oSh As PowerPoint.Shape

или

Dim oSh As Object

Если вы явно не объявите его, он будет ссылаться на объект из собственного приложения, в данном случае Excel. Object выполняет позднюю привязку и оставляет приложение для принятия решения во время выполнения.

РЕДАКТИРОВАТЬ

Базовый c пример того, как достичь того, что вы хотите, используя LATE BINDING ( приведенный ниже код не проверен ). Дайте мне знать, если вы получите какие-либо ошибки.

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