如何根据分页符拆分文档

ming0018

zhyuanqung 发表于 2018-2-28 09:40
斑竹，请教一下问题，我把代码放到word宏里面，显示Range没有定义，我想知道怎么修改？非常感谢！！！

我改出来了

szqhb

ming0018 发表于 2018-2-28 10:25
我改出来了

分享一下呢！
？

ming0018

szqhb 发表于 2018-2-28 10:54
分享一下呢！
？

    Dim tempDoc As Document
    Dim wRng As Range
    Dim tempPar As Paragraph
    Dim tempStr As String
    Set wRng = ActiveDocument.Content

    With wRng.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        Do While wRng.Start <> ActiveDocument.Content.End - 1
            If .Execute(findtext:="*^m", MatchWildcards:=True) Then
                '.Parent.Select
                ActiveDocument.Range(wRng.Start, wRng.End - 1).Select
            Else
                'wRng.Select
                wRng.Copy
            End If
            wRng.SetRange wRng.End + 1, ActiveDocument.Content.End
        Loop
    End With
    Set RegExp = Nothing

只做了copy工作，要另存文档，参考原代码改就行了。

zhyuanqung

ming0018 发表于 2018-2-28 11:26
Dim tempDoc As Document
    Dim wRng As Range
    Dim tempPar As Paragraph

谢谢，是能运行了。但是没见到保存的word文件。
我看了一下我的需求，我想按照分节符进行拆分。

网上下载了一个宏的代码，但是是页拆分的，我想改为按分节符拆分，您能帮忙改一下吗？多谢斑竹了。
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 ActiveDocument.Content.Information(wdNumberOfPagesInDocument)
                                                      '取得当前文件页数并设置为由第1页到最后一页的循环语句
        oSrcDoc.Bookmarks("\page").Range.Select       '全选当前页内容
        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

413191246se

请楼主关闭所有Word文档后，将原文件备份后放到一个新建文件夹中（Word2003测试通过）：

1. Sub test()
   
2.     Dim doc As Document, i$
   
3.     Set doc = ActiveDocument
   
4.     Do
   
5.         If Len(doc.Content) = 1 Then doc.Close savechanges:=wdDoNotSaveChanges: End
   
6.         Do
   
7.             doc.Paragraphs(1).Range.Select
   
8.             CommandBars.FindControl(ID:=122).Execute
   
9.             CommandBars.FindControl(ID:=123).Execute
   
10.             If Len(Selection) = 1 Then Selection.Delete Else i = Selection.Text: Exit Do
    
11.         Loop
    
12.         i = Replace(i, vbCr, "")
    
13.         Selection.HomeKey unit:=wdStory
    
14.         Selection.Find.Execute Chr(12), , , 1, , , 1
    
15.         If Selection.Find.Found = True Then
    
16.             Selection.HomeKey unit:=wdStory, Extend:=wdExtend
    
17. cont:
    
18.             Selection.Cut
    
19.             Selection.Delete
    
20.             Documents.Add.SaveAs FileName:=i, fileformat:=wdFormatDocument
    
21.             Selection.Paste
    
22.             ActiveDocument.Characters(1).Copy
    
23.             ActiveDocument.Paragraphs.Last.Range.Delete
    
24.             ActiveDocument.Close savechanges:=wdSaveChanges
    
25.         Else
    
26.             Selection.WholeStory
    
27.             GoTo cont
    
28.         End If
    
29.     Loop
    
30. End Sub

复制代码

ming0018

zhyuanqung 发表于 2018-2-28 13:16
谢谢，是能运行了。但是没见到保存的word文件。
我看了一下我的需求，我想按照分节符进行拆分。

要保存自己在后面加代码就行了

zhyuanqung

ming0018 发表于 2018-2-28 15:33
要保存自己在后面加代码就行了

谢谢啊，大牛。