VBA: 搜索形状时需要运行时错误“424”对象

Question

我创建了一个 VBA 脚本来将数据从 Excel 传输到 PowerPoint（均为 2016 版）并想检查幻灯片 x 上是否存在特定形状，然后将其复制到幻灯片 y .

() 中也提到的常见解决方案确实产生

"runtime error '424': Object required"

在 For Each oSh in myPresentation.Slides(4).Shape

函数的第 3 行

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），但它对我使用哪个错误没有影响。

就我而言，没有其他方法可以检查特定形状是否存在，因为每个运行都会重新分配形状索引，而且幻灯片 x 上的形状数量并不总是我的情况也一样。

如果有任何建议，我将不胜感激。谢谢

Answer 1

因为它在 Excel 和 Powerpoint 中都可用，所以通过显式声明避免混淆代码:)

Dim oSh As PowerPoint.Shape

或

Dim oSh As Object

如果您没有显式声明它，它将引用本机应用程序中的对象，在本例中为 Excel。 Object 进行后期绑定并让应用程序在运行时决定。

编辑

关于如何使用 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

VBA: 搜索形状时需要运行时错误“424”对象

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

excel

powerpoint

vba

shapes