以下为宏代码：

Attribute VB_Name = "模块1"
Sub toWord()
On Error Resume Next
Dim a As New Application
Dim sl As PowerPoint.slide
Dim sh As PowerPoint.shape
Dim c As PowerPoint.View
Dim i As Integer
i = 1
Dim str As String
str = ""
Set c = Application.ActiveWindow.View
For Each sl In PowerPoint.ActivePresentation.Slides
c.GotoSlide i
 str = str + "page" + VBA.str(i) + vbLf
 For Each sh In sl.Shapes
   sh.Select
   str = str + a.ActiveWindow.Selection.TextRange.Text + vbLf
 Next sh
i = i + 1
str = str + "----------------------------------------------" + vbLf
Next sl
Dim d As New Word.Application
Dim dd As Word.Document
d.Visible = True
d.Activate
Set dd = d.Documents.Add
dd.Select
dd.Words.First.Text = str
End Sub