Word用VBA代码每页拆分为一个文档

时间:2024-10-12 21:27:19

1、打开Word表格

Word用VBA代码每页拆分为一个文档

2、按alt+f11,打开VBA编辑器

Word用VBA代码每页拆分为一个文档

3、然后插入模块

Word用VBA代码每页拆分为一个文档

4、粘贴以下代码Option Explicit Sub SplitEveryFivePagesAsDocuments() On Error Resume Next 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 = 1 Set fso = CreateObject("Scripting.FileSystemObject") Set oSrcDoc = ActiveDocument Set oRange = oSrcDoc.Content nTotalPages = Val(ActiveDocument.BuiltInDocumentProperties(wdPropertyPages)) 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

Word用VBA代码每页拆分为一个文档

5、单击执行按钮

Word用VBA代码每页拆分为一个文档

6、确定结束

Word用VBA代码每页拆分为一个文档

7、即可看到同文件目录下,生成3个文档

Word用VBA代码每页拆分为一个文档

8、打开其中一个即为拆分的文档

Word用VBA代码每页拆分为一个文档
© 手抄报圈