类型不匹配循环形状

Jak*_*kob 4 excel powerpoint vba excel-vba

我在循环幻灯片中的形状的行中出现类型不匹配13错误.我可以看到它oShNothing,但如果我.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
Run Code Online (Sandbox Code Playgroud)

完整代码:

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
Run Code Online (Sandbox Code Playgroud)

Dmi*_*liv 6

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

Dim oSh As Shape
Run Code Online (Sandbox Code Playgroud)

到(早期绑定)

Dim oSh As PowerPoint.Shape
Run Code Online (Sandbox Code Playgroud)

或(对于后期绑定)

Dim oSh As Object 
Run Code Online (Sandbox Code Playgroud)

另请注意,如果您要使用带后期绑定的powerpoint(如建议您的函数名称Sub PPLateBinding()),则应将所有类型更改PowerPoint.SomethingObject(除非您添加对powerpoint对象模型的引用,但在这种情况下,我看不出任何原因使用后期绑定).

  • 是的,你应该做两个小的改动:1)从循环中剪切这一行`Set PowerPointApplication = CreateObject("PowerPoint.Application")`并在`If FileChosen = -1 Then`之后粘贴它.2)从循环中剪切线"PowerPointApplication.Quit"和"Set PowerPointApplication = Nothing"并在"下一个iPresentations"之后粘贴它们 (2认同)