应用思考-教育技术论坛

标题: 通过vba提取PPT中的文字 [打印本页]
作者: oduang    时间: 2023-9-16 21:15
标题: 通过vba提取PPT中的文字
环境准备：仅限于office环境下，WPS需在安装vba模块

提取步骤
1.打开PPT文件后，使用快捷键按ALT+F11（部分笔记本FN+ALT+F11）打开VBA编辑器
(, 下载次数: 211)
2.在菜单栏中选择“插入”→“模块”，添加一个模块
(, 下载次数: 186)
3.在菜单栏中选择“工具”→“引用”，寻找“Microsoft Word X.0 Object Library”（其中X与OFFICE版本有关，不唯一），选中并确定
(, 下载次数: 200)
4.在模块窗口插入下列代码
  1. Sub 提取文字()
  2. On Error Resume Next
  3. Dim temp As New Word.Document, tmpShape As Shape, tmpSlide As Slide
  4. For Each tmpSlide In ActivePresentation.Slides
  5. For Each tmpShape In tmpSlide.Shapes
  6. temp.Range().Text = temp.Range() + tmpShape.TextFrame.TextRange.Text
  7. Next tmpShape
  8. Next tmpSlide
  9. temp.Application.Visible = True
  10. End Sub
复制代码
(, 下载次数: 209)
5.使用快捷键F5（部分笔记本FN+F5）或菜单栏选择“运行”→“运行子过程/用户窗体”运行代码
6.过一段时间后（取决于电脑配置及文件大小），电脑会自动打开包含提取文字的word，另存为即可
(, 下载次数: 201)
补充代码下述代码可在PPT文件所在位置生成包含提取文字的txt文件
  1. Public Sub Main()
  2.     Dim temp As String, tmpShape As Shape, tmpSlide As Slide
  3.     Dim pptPageCount As Integer, MyFName As String
  4.     pptPageCount = ActivePresentation.Slides.Count
  5.     For j = 1 To pptPageCount
  6.             k = ActivePresentation.Slides(j).Shapes.Count
  7.             For l = 1 To k
  8.                 On Error Resume Next
  9.                     If ActivePresentation.Slides(j).Shapes(l).TextFrame.TextRange.Text <> "" Then
  10.                         temp = temp + ActivePresentation.Slides(j).Shapes(l).TextFrame.TextRange.Text + Chr(10)
  11.                     End If
  12.                 On Error GoTo 0
  13.             Next l
  14.     Next j
  15.     MyFName = ActivePresentation.Path & "" & Left(ActivePresentation.Name, Len(ActivePresentation.Name) - 5) & ".txt"  '确定新建的txt文件的路径
  16.     Call TextSave(MyFName, temp)
  17. End Sub
  18. Public Function TextSave(ByVal fileName As String, ByVal content As String)
  19.     Set fso = CreateObject("Scripting.FileSystemObject") '创建文件需要使用Scripting.FileSystemObject对象
  20.     Set myTxt = fso.CreateTextFile(fileName:=fileName, OverWrite:=True) '使用CreateTextFile创建文件
  21.     myTxt.Write content '使用Write方法写入sheet名，然后插入一个换行符
  22.     myTxt.Close
  23.     Set myTxt = Nothing
  24. End Function
复制代码



作者: etthink    时间: 2023-9-17 20:03
测试了一下，两种方法可以正常运行，后一种方法代码的PPT文件，供其它同学练习参考： (, 下载次数: 1043)



欢迎光临 应用思考-教育技术论坛 (http://etthink.com/) Powered by Discuz! X3.4