VBA提取PPT中的文字

阳光穿透心脏的1/2处 2023-07-06 04:52 5阅读 0赞

最近接到一个朋友的需求，需要将大量的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

运行结果：

![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4_size_16_color_FFFFFF_t_70_pic_center_100x100]  
![在这里插入图片描述][watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4_size_16_color_FFFFFF_t_70]

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

![在这里插入图片描述][20200216121348627.png_pic_center_150x120]

[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4_size_16_color_FFFFFF_t_70_pic_center_100x100]: https://img-blog.csdnimg.cn/20200216122534229.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4,size_16,color_FFFFFF,t_70#pic_center=100x100
[watermark_type_ZmFuZ3poZW5naGVpdGk_shadow_10_text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4_size_16_color_FFFFFF_t_70]: https://img-blog.csdnimg.cn/20200216122756558.png?x-oss-process=image/watermark,type_ZmFuZ3poZW5naGVpdGk,shadow_10,text_aHR0cHM6Ly9ibG9nLmNzZG4ubmV0L3FxXzM3NjA4Mzk4,size_16,color_FFFFFF,t_70
[822286811]: https://jq.qq.com/?_wv=1027&k=5V7RB2c
[20200216121348627.png_pic_center_150x120]: https://img-blog.csdnimg.cn/20200216121348627.png?#pic_center=150x120