Warning: file_get_contents(/data/phpspider/zhask/data//catemap/5/excel/26.json): failed to open stream: No such file or directory in /data/phpspider/zhask/libs/function.php on line 167

Warning: Invalid argument supplied for foreach() in /data/phpspider/zhask/libs/tag.function.php on line 1116

Notice: Undefined index: in /data/phpspider/zhask/libs/function.php on line 180

Warning: array_chunk() expects parameter 1 to be array, null given in /data/phpspider/zhask/libs/function.php on line 181
Vba 类型不匹配在形状中循环_Vba_Excel_Powerpoint - Fatal编程技术网

Vba 类型不匹配在形状中循环

Vba 类型不匹配在形状中循环,vba,excel,powerpoint,Vba,Excel,Powerpoint,我在幻灯片中循环形状的行中遇到了类型不匹配13错误。我可以看到oSh是无,但是如果我计数形状,幻灯片中有很多形状。这有什么意义 简要代码: 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 Res

我在幻灯片中循环形状的行中遇到了类型不匹配13错误。我可以看到
oSh
,但是如果我
计数
形状,幻灯片中有很多形状。这有什么意义

简要代码:

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
Dim oPP作为PowerPoint演示文稿
将操作系统设置为幻灯片
暗淡的oSh形状
针对oPP.幻灯片中的每个操作系统
对于oS.Shapes“0”中的每个oSh
Debug.Print oS.Shapes.Count
对于操作系统形状中的每个oSh
调试。打印“嘿”
出错时继续下一步
如果oSh.Type=14或oSh.Type=1,则
pText=oSh.TextFrame.TextRange.Text
ReDim保留arrBase(UBound(arrBase)+1)
arrBase(UBound(arrBase))=pText
'Debug.Print pText
ElseIf(oSh.HasTable)那么
作为整数的Dim i
对于i=2到oSh.Table.Rows.Count
重播保留arrComp(UBound(arrComp)+1)
arrComp(UBound(arrComp))=替换(oSh.Table.Cell(i,1)。Shape.TextFrame.TextRange.Text,vbLf,“&”:“&oSh.Table.Cell(i,3)。Shape.TextFrame.TextRange.Text
接下来我
如果结束
错误转到0
下一个职业安全与健康
'x=输入数据(arrBase、arrComp)
如果结束
下一个操作系统
“Debug.Print tbl.Shape.TextFrame.TextRange.Text”。单元格(1,1)。Shape.TextRange.Text
对峙结束
PowerPointApplication.退出
Set oPP=无
设置PowerPointApplication=Nothing
如果结束
下一个陈述
如果结束
端接头

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

Dim oSh As Shape
至(用于早期绑定)

或(用于后期绑定)


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

你应该初始化你的
oS
对象(幻灯片)@simoco-我的错,我忘了从我的代码中粘贴它,但它在那里你能显示你的完整代码吗?现在我看不出您在哪里初始化
oPP
,如果您使用的是excel中的这段代码,那么还应该有一个表示
PowerPoint.Application
@simoco的变量-当然,我只是为了方便而对其进行了缩写。我必须说,我已经在下面添加了完整的代码Expert eye。我本来就有这个问题,但问题是我得到了另一个错误,即Object Required 494,但只有当我选择多个文件时。也许你也可以帮我做些什么?是的,你应该做两个小小的改变:1)从循环中剪切这行
Set PowerPointApplication=CreateObject(“PowerPoint.Application”)
,然后粘贴到
之后,如果fileselected=-1,那么
。2) 剪切行
PowerPointApplication。从循环中退出
设置PowerPointApplication=Nothing
,并在
下一个i表示之后粘贴它们
Dim oSh As PowerPoint.Shape
Dim oSh As Object