要将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