vba - 类型不匹配循环遍历形状

Question

我在循环遍历幻灯片中的形状的行中收到类型不匹配 13 错误。我可以看到 oSh 是 Nothing，但如果我.Count 形状，幻灯片中有很多形状。这有什么意义？

简要代码:

Dim oPP As PowerPoint.Presentation
Dim oS As Slide
Dim oSh As Shape
For Each oS In oPP.Slides
    For Each oSh In oS.Shapes '<-- this line is the error line
        On Error Resume Next
        If oSh.Type = 14 _
                Or oSh.Type = 1 Then
            'do stuff            
        End If
        On Error GoTo 0
    Next oSh
Next oS

完整代码:

Sub PPLateBinding()
    Dim pathString As String
    'no reference required
    Dim PowerPointApplication As PowerPoint.Application
    Dim oPP As PowerPoint.Presentation
    Dim oS As Slide
    Dim oSh As Object
    Dim pText As String
    Dim cellDest As Integer
    Dim arrBase() As Variant
    Dim arrComp() As Variant
    ReDim Preserve arrBase(1)
    ReDim Preserve arrComp(1)

    Dim fd As FileDialog
    Dim FileChosen As Integer
    Dim FileName As String
    Dim iPresentations As Integer

    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    'use the standard title and filters, but change the
    fd.InitialView = msoFileDialogViewList
    'allow multiple file selection
    fd.AllowMultiSelect = True

    FileChosen = fd.Show
    If FileChosen = -1 Then
    'open each of the files chosen
    For iPresentations = 1 To fd.SelectedItems.Count
        'On Error Resume Next
        Set PowerPointApplication = CreateObject("PowerPoint.Application")
        Set oPP = PowerPointApplication.Presentations.Open(fd.SelectedItems(iPresentations))
        If Err.Number <> 0 Then
            Set oPP = Nothing
        End If

        If Not (oPP Is Nothing) Then
            cellDest = 0

            'We assume PP is already open and has an active presentation
            For Each oS In oPP.Slides
                'Debug.Print oPP.Slides.Count
                If oS.Shapes.Count > 0 Then
                    Debug.Print oS.Shapes.Count
                        For Each oSh In oS.Shapes
                            Debug.Print "hey"
                            On Error Resume Next
                            If oSh.Type = 14 Or oSh.Type = 1 Then
                                pText = oSh.TextFrame.TextRange.Text
                                ReDim Preserve arrBase(UBound(arrBase) + 1)
                                arrBase(UBound(arrBase)) = pText
                                    'Debug.Print pText
                            ElseIf (oSh.HasTable) Then
                                Dim i As Integer
                                For i = 2 To oSh.Table.Rows.Count
                                    ReDim Preserve arrComp(UBound(arrComp) + 1)
                                    arrComp(UBound(arrComp)) = Replace(oSh.Table.Cell(i, 1).Shape.TextFrame.TextRange.Text, vbLf, "") & ":::" & oSh.Table.Cell(i, 3).Shape.TextFrame.TextRange.Text
                                Next i
                            End If
                            On Error GoTo 0
                        Next oSh
                    'x = InputData(arrBase, arrComp)
                End If
            Next oS

            'Debug.Print tbl.Shape.TextFrame.TextRange.Text '.Cell(1, 1).Shape.TextRange.Text
            oPP.Close
            PowerPointApplication.Quit
            Set oPP = Nothing
            Set PowerPointApplication = Nothing
        End If
    Next iPresentations
    End If
End Sub

Answer 1

Excel 有自己的 Shape 类型(与 PowerPoint.Shape 类型不同)，因此您应该更改

Dim oSh As Shape

至(用于早期绑定(bind))

Dim oSh As PowerPoint.Shape

或(用于后期绑定(bind))

Dim oSh As Object 

另请注意，如果您要使用带有后期绑定(bind)的 powerpoint(如您的函数名称 Sub PPLateBinding() 所示)，您应该更改所有类型 PowerPoint.Something 到 Object (除非您添加对 powerpoint 对象模型的引用，但在这种情况下，我看不出有任何使用后期绑定(bind)的理由)。