类型不匹配循环形状

时间:2014-04-13 10:42:17

标签: excel vba excel-vba powerpoint

我在循环幻灯片中的形状的行中出现类型不匹配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

完整代码:

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

1 个答案:

答案 0 :(得分:5)

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

Dim oSh As Shape

to(用于早期绑定)

Dim oSh As PowerPoint.Shape

或(对于后期绑定)

Dim oSh As Object 

另请注意,如果您要使用带后期绑定功能的powerpoint(建议使用您的功能名称Sub PPLateBinding()),则应将所有类型PowerPoint.Something更改为Object(除非你添加了对powerpoint对象模型的引用,但在这种情况下,我没有看到使用后期绑定的任何原因。)