使用 VBA 在 MS Word 中使用通配符搜索循环获取标题信息

Question

我正在 MS Word 中执行通配符搜索循环，并使用以下代码在新文档中生成所有查找值的列表。我在输出中添加了页码。但是我想不出如何为搜索到的输出获取 headers 。请建议。

示例 Word 文档：

1 Heading
Text Text Text Text Text

--<Page Break>--

1.1 Heading
Text Text Text Text Text [Reference X1]

1.1.1 Heading
Text Text Text Text Text
Text Text Text Text Text
Text Text Text Text Text

--<Page Break>--

1.2 Heading
Text Text Text Text Text

1.2.1 Heading
Text Text Text Text Text
Text Text Text Text Text [Reference X2]
Text Text Text Text Text [Reference X3]

1、1.1 等标题是 MS word 中使用的默认标题样式。（对我来说，样式名称是“标题 1”、“标题 2”等）

我期望的输出如下表所示：

| Reference     | Heading        | Page  |
| Reference X1  | 1.1 Heading    | 2     |
| Reference X2  | 1.2.1 Heading  | 3     |
| Reference X2  | 1.2.1 Heading  | 3     |

到目前为止我能写的代码（在 table 中执行此查找和写入的子程序的一部分）是：

With oDoc
    Set oRange = .Range
    n = 1
    With oRange.Find
        .Text = "<Reference X[0-9]{1,}>"
        .Forward = True
        .MatchWildcards = True
        Do While .Execute
            strFound = oRange
            With oTable
                .Cell(n+1,1).Range.Text = strFound
                .Cell(n+1,3).Range.Text = oRange.Information(wdActiveEndPageNumber)
            End With
            n = n + 1
        Loop
    End With
End With

我已经有了定义这些变量的代码，在其中创建了 table 和所需的行。我只是对如何在找到的项目上方获得标题感到困惑。问题是一个标题下可以有一个或多个“Reference XX”。此外，标题级别可以是任何级别。我需要为使用通配符找到的每个项目单独的行。

Answer 1

您可以使用 predefined bookmark 找到您找到的文本部分的标题级别。由于此技巧使用 Selection object，您必须将“找到的文本”范围转移到 Selection。下面的代码片段显示了如何：

Option Explicit

Sub test()
    With ActiveDocument
        Dim foundThis As Range
        Set foundThis = .Range
        With foundThis.Find
            .Text = "<Reference X[0-9]{1,}>"
            .Forward = True
            .MatchWildcards = True
            Do While .Execute
                Dim strFound As String
                Dim heading As String
                strFound = foundThis.Text
                heading = foundThis.GoTo(What:=wdGoToBookmark, _
                                         Name:="\HeadingLevel").Paragraphs(1).Range.Text
                Debug.Print "string found: " & strFound & " on page " & _
                            foundThis.Information(wdActiveEndPageNumber) & _
                            ", Heading: " & heading
            Loop
        End With
    End With
End Sub

Answer 2

例如：

Sub GetRefHeadings()
Application.ScreenUpdating = False
Dim Rng As Range, StrOut As String, Tbl As Table
StrOut = "Ref." & vbTab & "Heading" & vbTab & "Page" & vbCr
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "<Reference X[0-9]@>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    Set Rng = .Paragraphs(1).Range
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
    StrOut = StrOut & .Text & vbTab & Rng.Paragraphs.First.Range.ListFormat.ListString & _
      " " & Split(Rng.Text, vbCr)(0) & vbTab & Rng.Information(wdActiveEndPageNumber) & vbCr
  Loop
End With
Set Rng = ActiveDocument.Range.Characters.Last
Rng.Text = StrOut
Set Tbl = Rng.ConvertToTable(Separator:=vbTab)
With Tbl
  .PreferredWidthType = wdPreferredWidthPercent
  .PreferredWidth = 100
  .Columns.PreferredWidthType = wdPreferredWidthPercent
  .Columns(1).PreferredWidth = 20
  .Columns(2).PreferredWidth = 70
  .Columns(3).PreferredWidth = 10
  .Rows(1).Range.Font.Bold = True
  .Rows(1).HeadingFormat = True
  '.Sort ExcludeHeader:=True, FieldNumber:=1
End With
Set Rng = Nothing: Set Tbl = Nothing
Application.ScreenUpdating = True
End Sub

如果您想要找到的文本的页数而不是标题的页数，请将 Rng.Information 更改为 .Information。

默认排序顺序是通过引用找到的，而不考虑引用 #，这与按标题排序一致。该代码还包含一个 commented-out 行，用于按参考编号排序。

使用 VBA 在 MS Word 中使用通配符搜索循环获取标题信息

Get heading information using a wild card search loop in MS Word using VBA

vba

ms-word

wildcard

heading

word-style