之前介绍通过PPT与Word格式之间的转换实现批量提取和编辑幻灯片上的文字内容后，李程艺（oduang）同学提供了一种更高效的方法，一键可以直接自动提取所有幻灯片中的文本。
在一键实现之前，需要先粘贴一段VBA代码，利用VBA可以扩展PPT的一些功能，或者在文后下载PPT源文件，然后再把自己的幻灯片粘贴到这个文件里。
具体实现原理和过程：
第一步：在视图功能区找到“宏”，或者启用PPT的开发工具。在PPT中进入VBA最快捷方法是在视图中，找到宏。（相当于快捷键ALT+F11）
第二步：起一个名字，然后创建宏。
第三步：粘贴/编辑代码
具体代码如下：
Sub 提取文字()On Error Resume NextDim temp As New Word.document, tmpShape As Shape, tmpSlide As SlideFor Each tmpSlide In ActivePresentation.SlidesFor Each tmpShape In tmpSlide.Shapestemp.Range().Text=temp.Range()+ tmpShape.Textframe.TextRange.TextNext tmpShapeNext tmpSlidetemp.Application.Visible = TrueEnd Sub
第四步：引用新对象
因为代码中定义了word.document对象，将PPT中提取的文字直接输出到word文档编辑，所以需要在工具-引用中选择：Microsoft Word 版本号 Object Library，否则会出现对象未定义，代码无法运行。
第五步：运行宏
第六步：代码自动创建一个word文档并自动打开，可以直接在word中编辑文字。
代码重用策略：将刚刚自己创建宏的PPT另存成PPTM格式，删除幻灯片，保留宏代码，以后需要提取其它幻灯片上文字时，把幻灯片粘贴到这个文件中，运行宏：视图-宏-选中宏名-运行宏。
下面是优化的代码，不需要再引用word对象，而是在PPT相同位置生成一个同名的文本文件(推荐)。
Public Sub 提取文本() Dim temp As String, tmpShape As Shape, tmpSlide As Slide Dim pptPageCount As Integer, MyFName As String pptPageCount = ActivePresentation.Slides.Count 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 temp=temp+ ActivePresentation.Slides(j).Shapes(l).Textframe.TextRange.Text + Chr(10) End If On Error GoTo 0 Next l Next j MyFName=ActivePresentation.Path&''& Left(ActivePresentation.Name, Len(ActivePresentation.Name) - 5) & '.txt' '确定新建的txt文件的路径 Call TextSave(MyFName, temp) End Sub Public Function TextSave(ByVal fileName As String, ByVal content As String) Set fso = CreateObject('scripting.FileSystemObject') '创建文件需要使用scripting.FileSystemObject对象 Set myTxt = fso.CreateTextFile(fileName:=fileName, OverWrite:=True) '使用CreateTextFile创建文件 myTxt.Write content '使用Write方法写入sheet名，然后插入一个换行符 myTxt.Close Set myTxt = Nothing End Function
其它参考：
利用VBA的跳转实现随机点名功能
设计一个可以自己出题的PPT