ppt提取文字

ALT+F11调出开发窗口

加入引用

插入模块

输入代码运行

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