如何用vba将word文档按照手动分页符拆分?

在一个word文档中插入了多个手动分页符,现在希望将该文档按照手动分页符拆分成若干个子文档,可以使用如下的代码:

Sub QQ1722187970()
    Const wdReplaceAll = 2
    Dim oRng As Range
    Dim oRng1 As Range
    Dim oRngT As Range
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oDoc1 As Document
    sPath = oDoc.Path
    Set oRng = Word.Selection.Range
    '先判断是否有选中区域,没有选中则表示整个文档
    If oRng.Start = oRng.End Then
        Set oRng = Word.ActiveDocument.Content
    End If
    '获取要执行操作的区域的起点和终点,用于查找替换时判断是否超出了选定区域
    iStart = oRng.Start
    iEnd = oRng.End
'    Debug.Print oRng.Text
    Set oRng1 = oRng
    With oRng1.Find
        i = 1
        j = 0
        .ClearFormatting
        .MatchWildcards = False
        .Text = "^m"
        '每执行一次查找,只要找到了结果,oRng对象会自动变成被找到的内容所在的区域
        Do Until .Execute() = False Or oRng1.Start > iEnd Or oRng1.End < iStart
            
            Set oDoc1 = Word.Documents.Add
            
            k = oRng1.Start
            Set oRngT = oDoc.Range(j, k)
            oRngT.Copy
            oDoc1.Content.Paste
            j = k + 1
            oDoc1.SaveAs2 sPath & "\" & i & ".doc"
            oDoc1.Close
            i = i + 1
        Loop
    End With
    Set oDoc1 = Word.Documents.Add
    k = oDoc.Content.End
    Set oRngT = oDoc.Range(j, k)
    oRngT.Copy
    oDoc1.Content.Paste
    oDoc1.SaveAs2 sPath & "\" & i & ".doc"
    oDoc1.Close
End Sub

 

       

发表评论