我在循环遍历幻灯片中的形状的行中收到类型不匹配 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
最佳答案
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)的理由)。
关于vba - 类型不匹配循环遍历形状,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/23041709/