Office宏 PowerPoint提取文字到Word

PowerPoint直接转存为大纲格式Word，会丢失一些非标题的内容文字，使用简单的脚本尽可能多的提取幻灯片中的文字到WORD。
该宏需要引用对应的WORD库。

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