问题描述

修改VBA分割WORD代码 改成文件名为知道区域文字

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 = 1

Set fso = CreateObject("Scripting.FileSystemObject")
Set oSrcDoc = ActiveDocument
Set oRange = oSrcDoc.Content

nTotalPages = ActiveDocument.Content.Information(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