现在的任务是要把PPT中所有文本提取出来,保存到word文档中,如以下PPT文档,有多张PPT,其中的文本分散在每一张PPT中,且每一张PPT中可能有多个文本框,想得到其中的文本,如果一个个文本框复制,则效率太低了。
![91abe291d590527b0db76d5ee444066f.png](https://img-blog.csdnimg.cn/img_convert/91abe291d590527b0db76d5ee444066f.png)
现在的思路是使用PPT VBA,将文本全部复制到word中。
1 引入word对象库
打开PPT,按ALT+F11打开VBA编辑器(部分电脑FN+ALT+F11),点击顶部的“工具”菜单,选择引用,找“Microsoft Word X.0 Object Library”(其中X与你的OFFICE版本有关),钩上,点确定:
![af5dad025b5d611394daa132b16b6fa4.png](https://img-blog.csdnimg.cn/img_convert/af5dad025b5d611394daa132b16b6fa4.png)
2 添加模块,输入PPT VBA代码
在左面的工程视图里点击右键,选择插入->模块,添加一个模块。
将下列代码贴到刚建立的模块里:
Sub 提取PPT中所有文本到word() On Error Resume Next Dim worddoc As New Word.Document, tmpShape As Shape, tmpSlide As Slide For Each tmpSlide In ActivePresentation.Slides For Each tmpShape In tmpSlide.Shapes worddoc.Range().Text = worddoc.Range() + tmpShape.TextFrame.TextRange.Text Next tmpShape Next tmpSlideEnd Sub
3 运行以上代码
按F5(部分电脑FN+F5)即可运行,便自动新建了一个word文档,并将PPT中的全部文本复制到了word中:
![7d7c746bf608bfee1a5c411aebeb1c4a.png](https://img-blog.csdnimg.cn/img_convert/7d7c746bf608bfee1a5c411aebeb1c4a.png)
如果只想提取当前单张PPT中的文本到word文档,可以使用以下VBA代码:
Sub 提取当前PPT中所有文本到word() On Error Resume Next Dim k As Integer '当前幻灯片索引号 k = Application.ActiveWindow.View.Slide.SlideNumber Dim worddoc As New Word.Document, tmpShape As Shape, tmpSlide As Slide For Each tmpShape In Application.ActivePresentation.Slides(k).Shapes worddoc.Range().Text = worddoc.Range() + tmpShape.TextFrame.TextRange.Text Next tmpShapeEnd Sub
-End-