开启左侧

通过vba提取PPT中的文字

[复制链接]
oduang 发表于 2023-9-16 21:15:08 | 显示全部楼层 |阅读模式 打印 上一主题 下一主题
环境准备:仅限于office环境下,WPS需在安装vba模块

提取步骤
1.打开PPT文件后,使用快捷键按ALT+F11(部分笔记本FN+ALT+F11)打开VBA编辑器

VBA编辑器

VBA编辑器

2.在菜单栏中选择“插入”→“模块”,添加一个模块

“插入”→“模块”

“插入”→“模块”

3.在菜单栏中选择“工具”→“引用”,寻找“Microsoft Word X.0 Object Library”(其中X与OFFICE版本有关,不唯一),选中并确定

“工具”→“引用”

“工具”→“引用”

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
复制代码
4.jpg

5.使用快捷键F5(部分笔记本FN+F5)或菜单栏选择“运行”→“运行子过程/用户窗体”运行代码
6.过一段时间后(取决于电脑配置及文件大小),电脑会自动打开包含提取文字的word,另存为即可
5.jpg
补充代码下述代码可在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
复制代码



参与人数 1威望 +2 金钱 +10 贡献 +2 收起 理由
etthink + 2 + 10 + 2 内容很精彩

查看全部评分总评分 : 威望 +2 金钱 +10 贡献 +2

欢迎造访我的博客:oduang.com

精彩评论1

正序浏览
etthink 发表于 2023-9-17 20:03:40 | 显示全部楼层
测试了一下,两种方法可以正常运行,后一种方法代码的PPT文件,供其它同学练习参考: 一键提取文字.rar (80.06 KB, 下载次数: 5)
欢迎大家多发帖,参与讨论,增进彼此了解。
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则


2关注

0粉丝

4帖子

会员达人更多+
广告位

关注我们:教育技术人

官方微信

官方微博

教育技术热线:

13955453231

学教育技术,上教育技术论坛!

教育技术论坛征稿范围:教育技术应用案例、教程文章、优秀作品等。

Email:sf@etthink.com

Copyright   ©2007-2026  应用思考-教育技术论坛  Powered by©Discuz!  技术支持:且行资源    ( 皖ICP备10014945号-4 )