一键就可以提取PPT中全部文字

之前介绍通过PPT与Word格式之间的转换实现批量提取和编辑幻灯片上的文字内容后，李程艺（oduang）同学提供了一种更高效的方法，一键可以直接自动提取所有幻灯片中的文本。

在一键实现之前，需要先粘贴一段VBA代码，利用VBA可以扩展PPT的一些功能，或者在文后下载PPT源文件，然后再把自己的幻灯片粘贴到这个文件里。

具体实现原理和过程：

第一步：在视图功能区找到“宏”，或者启用PPT的开发工具。在PPT中进入VBA最快捷方法是在视图中，找到宏。（相当于快捷键ALT+F11）

第二步：起一个名字，然后创建宏。

第三步：粘贴/编辑代码

具体代码如下：

Sub 提取文字()
On Error Resume Next
Dim temp As New Word.Document, tmpShape As Shape, tmpSlide As Slide
For Each tmpSlide In ActivePresentation.Slides
For Each tmpShape In tmpSlide.Shapes
temp.Range().Text=temp.Range()+ tmpShape.TextFrame.TextRange.Text
Next tmpShape
Next tmpSlide
temp.Application.Visible = True
End 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

原教程链接及PPT代码文件下载（二楼）

http://www.etthink.com/thread-285643-1-1.html