VBA提取PPT中的文字

最近接到一个朋友的需求，需要将大量的PPT中的文字提取出来并识别其中是否有错别字。
整理思路如下

1. 将PPT另存为pptm格式，这是一种可以执行代码的文件
2. 将以下代码放到VBE中，运行即可提取文字

Public Sub Main()
    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

运行结果：

喜欢折腾代码的加群（群号:822286811）一起交流学习【python、VBA、Shell、Linux、dos、爬虫、拆机、装系统技术交流群】，点击链接加入群聊【计算机技术交流】：点击加入群聊