Word分页程序代码

1. 打开文档。

2. 快捷键Alt + F11打开VBA编辑器，选择菜单“插入->模块”
3. 粘贴代码
Option Explicit
Sub SplitEveryFivePagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, strNewName As String
Dim oRange As Range
Dim nIndex As Integer, nSubIndex As Integer, nTotalPages As Integer, nBound As Integer
Dim fso As Object
Const nSteps = 110 ' 修改这里控制每隔几页分割一次
Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content
nTotalPages = rmation(wdNumberOfPagesInDocument)
oRange.Collapse wdCollapseStart
oRange.Select
For nIndex = 1 To nTotalPages Step nSteps
Set oNewDoc = Documents.Add
If nIndex + nSteps > nTotalPages Then
nBound = nTotalPages
Else
nBound = nIndex + nSteps - 1
End If
For nSubIndex = nIndex To nBound
oSrcDoc.Activate
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.Target = wdBrowsePage
Application.Browser.Next
oNewDoc.Activate
oNewDoc.Windows(1).Selection.Paste
Next nSubIndex
strSrcName = oSrcDoc.FullName
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName)) oNewDoc.SaveAs strNewName
oNewDoc.Close False
Next nIndex
Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub
4. 快捷键F5 运行，直到出现“完成”表示结束。

————————————————
打开要处理的WORD文档，然后ALT+F8调出宏处理窗口，新输入宏名称为MyPg。

点击右侧的编辑按钮，输入如下内容，完成后键盘F5即可。

但完成后最后2个文件也会会有问题，手动修改一下就行了。

Sub MyPg()
Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oNewDoc As Word.Document
Dim oRange As Word.Range
Dim lCurrentStart As Long
Dim lCurrentEnd As Long
Dim lDocumentEnd As Long
Dim lOutputCount As Long
lOutputCount = 0
Set oWord = GetObject(, "Word.Application")
Set oDoc = ActiveDocument
oDoc.Select
lCurrentStart = oWord.Selection.Start
lCurrentEnd = lCurrentStart
lDocumentEnd = oWord.Selection.End
oWord.Selection.Collapse wdCollapseStart
Do While (lCurrentEnd < lDocumentEnd)
oWord.Browser.T arget = wdBrowsePage
oWord.Browser.Next
oWord.Browser.Next
oWord.Browser.Next
oWord.Browser.Next
lCurrentEnd = oWord.Selection.End
If (lCurrentStart = lCurrentEnd) Then
lCurrentEnd = lDocumentEnd
End If
Set oRange = oDoc.Range(lCurrentStart, lCurrentEnd)
Set oNewDoc = oWord.Documents.Add
oRange.Copy
oNewDoc.Range(0, 0).Paste
lOutputCount = lOutputCount + 1
oNewDoc.SaveAs FileName:="d:\" & lOutputCount & ".doc"
oNewDoc.Close
lCurrentStart = lCurrentEnd
Loop
End Sub
首先打开要拆分的文档，然后按alt+f11（打开vb）在这里插入，模块，然后复制下列代码：
Option Explicit
Sub SplitPagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, 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 rmation(wdNumberOfPagesInDocument)
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.T arget = 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
注意：不要关闭该vb窗口，直接按f5执行就可以了。

不过那个是按单页拆分的。

如果想按照指定页数拆分，请使用下面的代码，其它步骤和原来那个方案相同。

Option Explicit
Sub SplitEveryFivePagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, strNewName As String
Dim oRange As Range
Dim nIndex As Integer, nSubIndex As Integer, nT otalPages As Integer, nBound As Integer Dim fso As Object
Const nSteps = 200 ' 修改这里控制每隔几页分割一次
Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content
nT otalPages = rmation(wdNumberOfPagesInDocument)
oRange.Collapse wdCollapseStart
oRange.Select
For nIndex = 1 To nT otalPages Step nSteps
Set oNewDoc = Documents.Add
If nIndex + nSteps > nT otalPages Then
nBound = nT otalPages
Else
nBound = nIndex + nSteps - 1
End If
For nSubIndex = nIndex To nBound
oSrcDoc.Activate
oSrcDoc.Bookmarks("\page").Range.Copy
oSrcDoc.Windows(1).Activate
Application.Browser.T arget = wdBrowsePage
Application.Browser.Next
oNewDoc.Activate
oNewDoc.Windows(1).Selection.Paste
Next nSubIndex
strSrcName = oSrcDoc.FullName
strNewName = fso.BuildPath(fso.GetParentFolderName(strSrcName), _
fso.GetBaseName(strSrcName) & "_" & (nIndex \ nSteps + 1) & "." & fso.GetExtensionName(strSrcName))
oNewDoc.SaveAs strNewName
oNewDoc.Close False
Next nIndex
Set oNewDoc = Nothing
Set oRange = Nothing
Set oSrcDoc = Nothing
Set fso = Nothing
MsgBox "结束！"
End Sub
————————————————
版权声明：本文为CSDN博主「dldw777」的原创文章，遵循CC 4.0 BY-SA版权协议，转载请附上原文出处链接及本声明。

原文链接：https:///dldw777/java/article/details/83110842
1、在Word里面bai打开那个需要分割的文档（假设它的du文件名zhi叫做“原始文档.doc”）；
键入daoALT+F11打开VBA编辑器，选择菜单“插入-模块”；
粘贴下面的代码：
Option Explicit
Sub SplitPagesAsDocuments()
Dim oSrcDoc As Document, oNewDoc As Document
Dim strSrcName As String, 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 rmation(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
键入F5运行，看到“完成！”结束。

2、检查当前文档所在路径下是否生成若干名为“原始文档_n.doc”（n代表其对应原始文档中的第几页）的文档，检查它们的内容是否就对应于原始文档每个页面的内容。

如文档中有分节符分解后的文档会出现空白页，如要分解后不出现空白页，需要把文档中的分节符删除。

消除分节符的方法：
注意事项
分节符若全部替换，要注意替换后文档可能会出现排版混乱，这则需要自己手动排版了。