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

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

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

示例 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     |

到目前为止我能够编写的代码（执行此查找并写入表格的子程序的一部分）是：

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.@R_252_4045@ion(wdActiveEndPageNumber)
            End With
            n = n + 1
        Loop
    End With
End With

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

解决方法

例如：

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。

默认的排序顺序是通过引用找到的，与引用编号无关，这与按标题排序是一致的。该代码还包含一个注释掉的行，用于按参考编号进行排序。

您可以使用 predefined bookmark 找到您找到的文本部分的标题级别。由于此技巧使用 Selection 对象，因此您必须将“找到的文本”范围转移到 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