常规方法导不出文本框、形状、备注中文字
那么 我们用终极方法：VBA宏导出所有文本（含文本框 / 形状）
操作步骤
- 1、启用开发工具：
- 微软 Office：文件→选项→自定义功能区→勾选「开发工具」→确定
- WPS：文件→选项→自定义功能区→勾选「开发工具」→确定
- 3、在左侧工程窗口右键点击你的 PPT→「插入」→「模块」
Sub 提取PPT所有文字到Word() On Error Resume Next ' 引用Word对象库（工具→引用→勾选Microsoft Word X.0 Object Library） Dim wordApp As New Word.Application Dim wordDoc As Word.Document Dim slide As Slide Dim shape As Shape Dim notePage As Slide ' 创建新Word文档 Set wordDoc = wordApp.Documents.Add wordApp.Visible = True ' 遍历所有幻灯片 For Each slide In ActivePresentation.Slides wordDoc.Range.InsertAfter "=== 第" & slide.SlideIndex & "页 ===" & vbCrLf ' 提取幻灯片中所有形状的文字 For Each shape In slide.Shapes If shape.HasTextFrame And shape.TextFrame.HasText Then wordDoc.Range.InsertAfter shape.TextFrame.TextRange.Text & vbCrLf End If Next shape ' 提取备注页文字 If slide.HasNotesPage Then wordDoc.Range.InsertAfter "【备注】" & vbCrLf For Each shape In slide.NotesPage.Shapes If shape.HasTextFrame And shape.TextFrame.HasText Then wordDoc.Range.InsertAfter shape.TextFrame.TextRange.Text & vbCrLf End If Next shape End If wordDoc.Range.InsertAfter vbCrLf Next slide MsgBox "文字提取完成！", vbInformationEnd Sub
5、点击顶部「工具」→「引用」，勾选Microsoft Word X.0 Object Library（X 为你的 Office 版本号，如 16.0 对应 Office 2016/2019/365） 【这一步至为关键】6、按 F5 运行代码，系统会自动打开一个包含所有文字的 Word 文档由于提取了备注里的文字，所以可能会显得比较乱，要是不想提取备注里的文字，也可将 ' 提取备注页文字 那段删掉，就是下面这段：' 提取备注页文字 If slide.HasNotesPage Then wordDoc.Range.InsertAfter "【备注】" & vbCrLf For Each shape In slide.NotesPage.Shapes If shape.HasTextFrame And shape.TextFrame.HasText Then wordDoc.Range.InsertAfter shape.TextFrame.TextRange.Text & vbCrLf End If Next shape End If
