types不匹配循环通过形状

我在循环显示幻灯片中的graphics的行中出现types不匹配13错误。 我可以看到,这个“ 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 

Excel有它自己的Shapetypes(与PowerPoint.Shapetypes不一样),所以你应该改变

 Dim oSh As Shape 

(为了更早的绑定)

 Dim oSh As PowerPoint.Shape 

或(为了晚期装订)

 Dim oSh As Object 

另外请注意,如果您打算使用晚期绑定的PPT(build议您的函数名称为Sub PPLateBinding() ),您应该将所有types的PowerPoint.Something改为Object (除非添加了对powerpoint对象模型的引用,但在这种情况下我没有看到使用后期绑定的任何理由)。