MergeShapes 在声明为 Object 而不是显式声明为 ShapeRange 时失败

Question

我有一段在 PowerPoint 上使用后期绑定的代码，我希望执行的操作之一是合并 2 个形状。

当我尝试执行此操作时，我收到“运行时错误‘13’：类型不匹配”。具体来说，只有当我最初将 ShapeRange 声明为对象（因为后期绑定）而不是 ShapeRange（需要早期绑定）时，才会发生这种情况。在 PowerPoint 中调用以下 2 个函数时，first (

MergeShapes_Success

) 将成功，而 second (

MergeShapes_Failure

) 将失败。 （如果使用早期绑定从另一个应用程序调用，第一个函数也会成功）

两个函数之间的唯一区别是

shpRng

是否声明为

Object

或

ShapeRange

。

Private Function MergeShapes_Success(ByRef Shape1 As Object, Shape2 As Object) As Boolean
    Dim shpRng As PowerPoint.ShapeRange 'This is the only line that differs
    
    If Not (Shape1.Parent Is Shape2.Parent) Then
        MsgBox "Shapes to Merge must be on the same Slide!", vbCritical, "Error!"
        MergeShapes_Success = False
        Exit Function
    End If
    
    Set shpRng = Shape1.Parent.Shapes.Range(Array(Shape1.ZOrderPosition, Shape2.ZOrderPosition))
    
    shpRng.MergeShapes msoMergeUnion
    ' Shapes Merge Successfully
    
    MergeShapes_Success = True
End Function

Private Function MergeShapes_Failure(ByRef Shape1 As Object, Shape2 As Object) AS Boolean
    Dim shpRng As Object 'This is the only line that differs
    
    If Not (Shape1.Parent Is Shape2.Parent) Then
        MsgBox "Shapes to Merge must be on the same Slide!", vbCritical, "Error!"
        MergeShapes_Failure = False
        Exit Function
    End If
    
    Set shpRng = Shape1.Parent.Shapes.Range(Array(Shape1.ZOrderPosition, Shape2.ZOrderPosition))
    
    shpRng.MergeShapes msoMergeUnion
    ' /*************************
    ' ** Run-time error '13': **
    ' ** Type mismatch        **
    ' *************************/
    
    MergeShapes_Failure = True
End Function

我在

TypeName

之后检查了 shpRng 的

Set

（在这两种情况下都返回“ShapeRange”），并且我也确认了在这两种情况下

TypeOf shpRng Is ShapeRange

。

有谁能够建议为什么会发生这种情况，以及理想情况下如何使用后期绑定来实现此功能……好吧，功能？

Answer 1

错误消息并不意味着声明（

As Object

）错误...`MergeShapes1 的参数不合适。请测试适配的功能：

Private Function MergeShapes_Failure(ByRef Shape1 As Object, Shape2 As Object) As Boolean
    Dim shpRng As Object 
    
    If Not (Shape1.Parent Is Shape2.Parent) Then
        MsgBox "Shapes to Merge must be on the same Slide!", vbCritical, "Error!"
        MergeShapes_Failure = False
        Exit Function
    End If
    
    Set shpRng = Shape1.Parent.Shapes.Range(Array(Shape1.ZOrderPosition, Shape2.ZOrderPosition))

    
    On Error GoTo Problem
     shpRng.MergeShapes 1, Shape1 'The second parameter is required, even if in documentation is Optional
                                  'Using Late Binding the constant msoMergeUnion does not have much of a meaning, too...
    
     MergeShapes_Failure = True
     Exit Function
Problem:
    
End Function