使用VBA将大纲级别定义良好的单个Word文档按指定的大纲样式分割成多个文档

我们知道,大纲级别定义良好的Word文档可以轻松用MindManager转换成思维导图。但是,对于一个极长的文档,例如一本教材,直接导入MindManager转换后的思维导图,因为内容过多,仍然很难阅读。这时候,可以考虑分章节将长文档分割成一个一个小文档,再将小文档导入MindManager,转换后的思维导图就比较好用了。
下面的宏可以将一个极长的文档分成每一个“标题 4”段落及其所属内容构成的短文档。如果想按其他级别的段落来分割文档,只需将宏中的变量styleName赋为其他值即可。要让宏正常运行,要注意最后一页有且只能有一个样式为styleName的段落,具体处理办法参见代码注释。
除了可以按样式名分割文档,直接按大纲级别(OutlineLevel)来分割文档也是可以的,只需要将以下代码中的If .ParagraphFormat.Style = styleName Then一行注释掉,并取消下一行If .Paragraphs(1).OutlineLevel = OlLevel then的注释,其中,OlLevel是指定大纲级别的变量。

Sub 按大纲级别分割文档()

     Dim pos%, i%, rng As Range, titPara As Paragraph
     Dim subDoc As Document, mainDoc As Document, fileName$, styleName$, olLevel%
     
     Set mainDoc = ActiveDocument '原文档对象
     styleName = "标题 4" '指定的分割文档的大纲级别对应的段落的样式名称
     olLevel = 4
     pages = mainDoc.ComputeStatistics(wdStatisticPages) '获取文档总页数     
     i = 1
     
     Application.ScreenUpdating = False
     ' 某些版本的office执行文档创建关闭会出现操作无效错误,忽略
     On Error Resume Next
     With Selection        
        ' 光标移动至文档开头
        .HomeKey unit:=wdStory        
        Do

            'If .ParagraphFormat.Style = styleName Then ' 根据样式名定位原文档分割位置
            If .Paragraphs(1).OutlineLevel = olLevel Then '根据大纲级别定位原文档分割位置
                Set titPara = .Paragraphs(1)
                '一个数字序列号+指定大纲段落文本作为分割文件的文件名
                '也可每移动一个标题比较一下当前标题的大纲级别与指定样式段落的大纲级别
                '如果当前段落大纲级别较高,则将段落文本连接起来作为文件名的一部分,
                '这样,从文件名即可看出该文件所属的章节
                fileName = Mid(titPara.Range, 1, Len(titPara.Range) - 1) '去掉段落末尾的回车符号
                ' 如果原文档标题4是以序号加上顿号做前缀,在文件名中去掉前缀。没有顿号pos会返回0
                pos = InStr(fileName, "、")
                ' 拼接文件名
                fileName = Format(i, "00000") & Mid(fileName, pos + 1)
                Set rng = .Bookmarks("\headinglevel").Range '获取该标题下所有内容
                rng.Copy '复制内容保存到分割的文档中
                Set subDoc = Documents.Add '新建文档保存分割出的内容
                ' 指定分割的文档中“正文”样式的字体
                With subDoc.Styles("正文").Font
                    .NameFarEast = "宋体"
                    .NameAscii = "Source Code Pro"
                    .NameOther = "Source Code Pro"
                End With
                subDoc.Content.Paste '粘贴复制的内容,源格式粘贴
                ' 将字体文件嵌入分割的文档中一起保存,移植到缺少Source Code Pro字体的电脑也能正常显示格式
                subDoc.EmbedTrueTypeFonts = True
                subDoc.SaveAs "D:\temp\test\" & fileName & ".docx" '保存分割的文档中
                subDoc.Close '关闭分割的文档中
                mainDoc.Activate '激活原文档,防止意外处理其他文档
                i = i + 1
            End If
            .GoTo wdGoToHeading, wdGoToNext, 1 '光标移动到下一个标题
            pos = .Information(wdActiveEndPageNumber) '记录光标到达页码
            If pos = pages Then '判断是否到达最后一页
                '到达最后一页则结束循环。如果最后一页有多个样式为styleName的段落,只有第一个会被分割。
                '可以考虑在最后一页最后一个样式为styleName的段落前加一个分页符,将最后一页分成两页
                '如果最后一页没有样式为styleName的段落,可以在文档最后多输入一个空行并指定样式为styleName
                Exit Do
            End If
        Loop
    End With
    Set subDoc = Nothing
    Set mainDoc = Nothing
    Set rng = Nothing
    Debug.Print "共生成新文档数量为" & (i - 1)
    Debug.Print "处理完成。"
    Application.ScreenUpdating = True
End Sub

上述代码中只有一个技巧值得注意,那就是使用预定义书签"\headinglevel"取得指定样式段落所属的全部内容(包括子标题、文本段落和图片、表格等)。
Word中的预定义书签有下面一些(来源:微软官方文档)

Bookmark 说明
\Sel 当前所选内容或插入点。
\PrevSel1 发生编辑的最新选择;转到此书签等效于运行 一次 GoBack 方法。
\PrevSel2 倒数第二次编辑过的所选内容;定位至该书签相当于运行两次 GoBack 方法。
\StartOfSel 当前所选内容的起点。
\EndOfSel 当前所选内容的终点。
\Line 当前行或当前所选内容的首行。 如果插入点在本段非最后一行的行尾,该书签包含完整的下一行。
\Char 当前字符,它是插入点后面的字符(当没有选定内容时)或所选内容的第一个字符。
\Para 当前段,即包含插入点的段,或在选定多个段落时所选段落中的第一段。 请注意,如果插入点或所选内容位于文档的最后一段,则“\Para”书签不包含段落标记。
\Section 当前节,并可能包含节尾的分隔符。 当前节包含插入点或所选内容。 如果所选内容包含多个节,则“\Section”书签为所选内容中的第一节。
\Doc 活动文档中的全部内容(文档结尾处的段落标记除外)。
\Page 当前页,并可能包含页尾的分隔符。 当前页包含插入点。 如果当前所选内容包含多页,则“\Page”书签为所选内容的第一页。 注意,如果插入点或所选内容位于文档中的最后一页,则“\Page”书签不包含文档结尾的段落标记。
\StartOfDoc 文档开头。
\EndOfDoc 文档结尾。
\Cell 表格中当前的单元格,即包含插入点的单元格。 如果当前所选内容包含表中一个或多个单元格,则“\Cell”书签为所选内容的第一个单元格。
\Table 当前表格,即包含插入点或所选内容的表格。 如果所选内容包含多个表格,则“\Table”书签为所选内容中完整的第一个表格(即使未选定完整的表格)。
\HeadingLevel 包含插入点或所选内容的标题,及其子标题和文字。 如果当前所选内容为正文文字,则“\HeadingLevel”书签包含上一个标题以及该标题包含的任何子标题和文字。

你可能感兴趣的:(word,VBA)