通过EXCEL 打开PPT文件提取文字信息，在其它电脑上无效

尘中之尘

我自己写了一个代码，在我的台式机上用wps可以很好的运行，但是在笔记本电脑上不能用，请大神们给看看。具体详见附件



还有，我发现

fxl447098457

自己检查下结果。我只是修改了ppt相关的运行代码,其他的没动。 汇总模板.zip (66.45 KB, 下载次数: 5)

2023-11-30 10:00 上传

点击文件名下载附件

fxl447098457

考虑调用不同版本的组件前期引用的问题,最好写完后改成后期绑定。用createobject。

尘中之尘

感谢你的回复，我试试

尘中之尘

fxl447098457 发表于 2023-11-30 09:12
考虑调用不同版本的组件前期引用的问题,最好写完后改成后期绑定。用createobject。

我是新手，不是很明白，能帮我改改吗？谢谢

fxl447098457

尘中之尘 发表于 2023-11-30 09:21
我是新手，不是很明白，能帮我改改吗？谢谢

Public Sub Main()
    Dim temp As String, tmpShape As Shape
    Dim pptPageCount As Integer, MyFName As String
    Dim pptapp As Object, ActivePresentation As Object
    Set pptapp = CreateObject("powerpoint.application")
    Set ActivePresentation = pptapp.Presentations.Open(ThisWorkbook.Path + "\11月第3周.pptx")
    pptPageCount = ActivePresentation.Slides.Count
    iii = 1
    For j = 1 To pptPageCount
            k = ActivePresentation.Slides(j).Shapes.Count
            For l = 1 To k
                On Error Resume Next
                    If ActivePresentation.Slides(j).Shapes(l).TextFrame.TextRange.Text <> "" Then
                    
                        aa = ActivePresentation.Slides(j).Shapes(l).TextFrame.TextRange.Text
                        bb = Replace(aa, Chr(13), "+")
                        
                        temp = temp & bb & "+"
                        aa = ""
                    End If
                On Error GoTo 0
            Next l
            
            ReDim Preserve arr1(1 To 1, 1 To iii)           '重新声明数组arr1
            arr1(1, iii) = temp
            temp = ""
            iii = iii + 1
    Next j
   
    ActivePresentation.Close
    pptapp.Quit
End Sub

尘中之尘

fxl447098457 发表于 2023-11-30 10:00
自己检查下结果。我只是修改了ppt相关的运行代码,其他的没动。

非常感谢，谢谢