Dim oSrcDoc As Document, oNewDoc As Document Dim strSrcName AsString, strNewName AsString Dim oRange As Range Dim nIndex AsInteger, nSubIndex AsInteger, nTotalPages AsInteger, nBound AsInteger Dim fso AsObject
Const nSteps = 9
Set fso = CreateObject("Scripting.FileSystemObject") Set oSrcDoc = ActiveDocument Set oRange = oSrcDoc.Content
nTotalPages = ActiveDocument.Content.Information(wdNumberOfPagesInDocument) oRange.Collapse wdCollapseStart oRange.Select For nIndex = 1To nTotalPages Step nSteps Set oNewDoc = Documents.Add If nIndex + nSteps > nTotalPages Then nBound = nTotalPages Else nBound = nIndex + nSteps - 1 EndIf 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) & "." & fso.GetExtensionName(strSrcName)) oNewDoc.SaveAs strNewName oNewDoc.Close False Next nIndex Set oNewDoc = Nothing Set oRange = Nothing Set oSrcDoc = Nothing Set fso = Nothing MsgBox "结束!"