用VBA写一段代码在word文档的三页内容通过缩小字体放到一页中

Sub ShrinkToFit()

'将当前页的内容复制到剪贴板
Selection.WholeStory
Selection.Copy

'新建一页，将内容粘贴到新页
Dim newDoc As Document
Set newDoc = Documents.Add
newDoc.Range.Paste

'缩小字体，使得三页内容适合一页
Dim p As Paragraph
For Each p In newDoc.Content.Paragraphs
    p.Range.Font.Size = p.Range.Font.Size - 1
Next p

End Sub