如何使用其大纲到子文档（使用VBA）读取MS Word DOCX？

Question

我正在尝试使用Word-VBA从master-DOCX的每个部分创建多个Word子文档。

MAIN DOCX打印版面

MAIN DOCX大纲查看 - 所有级别

MAIN DOCX大纲视图 - 四个级别

示例输出将是：

子文档（DOCX＆＃39; s）获得与上面类似的名称（包括该部分第一个单词中使用的样式名称）。内容包含一些富文本，例如有些词可能是粗体，斜体等等。

非常感谢有关如何使用Word-VBA解决此问题的评论。

以下代码是问题的核心。它使用Word编辑/查找/转到/标题命令在“轮廓级别”中递增。但是，当涉及多个段落标记时，我无法找到一种方法来选择大纲级别之间的所有文本。我想将此富文本复制到其中一个子文档中。

Sub Goto_Outline_Levels()
    ActiveWindow.ActivePane.View.Type = wdPageView
    Selection.HomeKey Unit:=wdStory
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
    Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
End Sub

Answer 1

这样的技巧就是使用Range对象。与选择不同，您的代码可以使用多个范围。因此，您可以将标题部分的起点保存在一个范围内，将结束点（下一个标题部分的开头）保存在另一个范围内，将子文档的内容保存在第三个范围内。

Sub CreateSubDocsPerHeadingStyle()
    Dim doc As word.Document
    Dim rngStart As word.Range
    Dim rngEnd As word.Range
    Dim rngSubDoc As word.Range

    Set doc = ActiveDocument
    Selection.HomeKey Unit:=wdStory
    Do
        Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
        Set rngStart = Selection.Range
        Selection.GoTo What:=wdGoToHeading, Which:=wdGoToNext, Count:=1, Name:=""
        Set rngEnd = Selection.Range
        rngEnd.Collapse wdCollapseStart
        If rngEnd.End = rngStart.Start Then
            'At the last heading section
            rngEnd.End = doc.content.End
        End If
        Set rngSubDoc = doc.Range(rngStart.Start, rngEnd.End)
        rngSubDoc.Select
        rngSubDoc.Subdocuments.AddFromRange rngSubDoc
        rngEnd.Select
    Loop While rngEnd.End <> doc.content.End
End Sub