起因

我有些ppt需要转换成word文稿，但是一个一个复制太麻烦了。

有一种普遍的方法是打印大纲，但是我这ppt里面他没有大纲啊（（（

然后就有一种通过脚本的方式来提取文字

记得要引用`Microsoft Word`，很重要！

代码

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

Sub ExtractTextToWordDoc()
  Dim objPresentation As Presentation
  Dim objSlide As slide
  Dim objShape As shape
  Dim objTextFrame As TextFrame
  Dim objTextRange As TextRange
  Dim strOutput As String
  Dim objWord As Object
  Dim objDoc As Object

  Set objPresentation = ActivePresentation
  Set objWord = CreateObject("Word.Application")
  Set objDoc = objWord.Documents.Add

  For Each objSlide In objPresentation.Slides
    For Each objShape In objSlide.Shapes
      If objShape.HasTextFrame Then
        Set objTextFrame = objShape.TextFrame
        Set objTextRange = objTextFrame.TextRange
        strOutput = strOutput & objTextRange.text & vbCrLf
      End If
    Next
  Next

  objDoc.Range.InsertAfter strOutput
  objDoc.SaveAs "D:\Output.docx"
  objDoc.Close
  objWord.Quit

  MsgBox "文本提取已完成！"
End Sub