如何用vba把word文档的每页单独保存为一个word文档

 要将word文档的每页单独保存为一个word文档，首先需要能够逐页遍历word文档。

逐页遍历word文档可以使用word的定位功能。

代码如下：

Sub SplitToOnePage()
    Const wdNumberOfPagesInDocument = 4
    Const wdGoToPage = 1
    Const wdGoToAbsolute = 1
    Dim oDoc As Document
    Dim oRng As Range
    Dim oDocTemp As Document
    Set oDoc = Word.ActiveDocument
    Dim sPath As String
    sPath = Word.ActiveDocument.Path
    Dim iPageNo As Long
    '获取总页数
    With oDoc
    iPageNo = .Range.Information(wdNumberOfPagesInDocument)
        For I = 1 To iPageNo
            '定位到页开始
            Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, Count:=I)
            oRng.Select
            '定位整个页面区域
            oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End
            oRng.Copy
            Set oDocTemp = Word.Documents.Add
            With oDocTemp.Application.Selection
                .Paste
            End With
            oDocTemp.SaveAs2 sPath & "\" & I & ".docx"
            oDocTemp.Close
        Next I
    End With
End Sub

=====================================
可以保存任何内容

Option Explicit

Sub SplitPagesAsDocuments()
	Dim oSrcDoc As Document
	Dim oNewDoc As Document
	Dim strSrcName As String
	Dim strNewName As String
	Dim oRange As Range
	Dim nIndex As Integer
	Dim fso As Object
	Set fso     = CreateObject("Scripting.FileSystemObject")
	Set oSrcDoc = ActiveDocument
	Set oRange  = oSrcDoc.Content
	oRange.Collapse wdCollapseStart
	oRange.Select

	For nIndex = 1 To ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
		oSrcDoc.Bookmarks("\page").Range.Copy
		oSrcDoc.Windows(1).Activate
		Application.Browser.Target = wdBrowsePage
	Application.Browser.Next

	strSrcName                  = oSrcDoc.FullName
	strNewName                  = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
	fso.GetBaseName(strSrcName) & "_" & nIndex & "." & fso.GetExtensionName(strSrcName))
	Set oNewDoc                 = Documents.Add
	Selection.Paste
	oNewDoc.SaveAs strNewName
	oNewDoc.Close False
Next

Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub

==========================================
可以保存任何内容

Sub QQ1722187970()
    Const wdNumberOfPagesInDocument = 4
    Const wdGoToPage = 1
    Const wdGoToAbsolute = 1
    Dim oDoc As Document
    Dim oRng As Range
    Dim oDocTemp As Document
    Set oDoc = Word.ActiveDocument
    Dim sPath As String
    sPath = Word.ActiveDocument.Path
    Dim iPageNo As Long
    '获取总页数
    With oDoc
    iPageNo = .Range.Information(wdNumberOfPagesInDocument)
        For I = 1 To iPageNo
            '定位到页开始
            Set oRng = .GoTo(wdGoToPage, Which:=wdGoToAbsolute, Count:=I)
            oRng.Select
            '定位整个页面区域
            oRng.SetRange oRng.Start, oRng.Bookmarks("\page").End
            oRng.Copy
            Set oDocTemp = Word.Documents.Add
            With oDocTemp.Application.Selection
                .Paste
            End With
            oDocTemp.SaveAs2 sPath & "\" & I & ".docx"
            oDocTemp.Close
        Next I
    End With
End Sub

===========================================
只能保存文字 
Option Explicit

Sub SaveParagraph()
	Dim i As Integer
	Dim PageNo As Integer
	Dim aDoc As Document
	Dim myDoc As Document
	Dim sPage As String
	Set myDoc              = ThisDocument
	'文档视图设定为页面方式
	ActiveWindow.View.Type = wdPageView
	myDoc.Repaginate
	'获得文档页数并赋值给变量 PageNo
	PageNo = myDoc.BuiltInDocumentProperties(wdPropertyPages)

	For i = 1 To PageNo
		myDoc.Activate
		' 光标移动到文档某一页的开始
		Selection.GoTo What: = wdGoToPage, Which: = wdGoToNext, Name: = i
		' 全选文档某一页的所有内容
		Selection.EndKey Unit: = wdStory, Extend: = wdExtend
		sPage = Selection.Text
		'保存到一个文件中
		Set aDoc = Documents.Add
		aDoc.Content.Text = sPage
		aDoc.SaveAs FileName: = "c:\" & CInt(i) & ".doc"
		aDoc.Close
	Next

End Sub

word中怎样把不同颜色的下划线文字变成对应的颜色