如何为Word段落文本匹配对应带编号的标题

需求说明 #

提取Word文档中的所有段落文本，并为每个段落关联最近的纯编号标题（仅识别列表格式的纯编号，如1、1.1这类，排除Section 1带前缀的标题）。最终生成两组对应数组，格式示例如下：

[, text one, text two, text three]
[, 1       , 1      , 1.1       ]

遇到的问题 #

已实现通过逗号分隔字符串转数组获取文本，但无法正确关联最近的编号标题：

• 尝试使用OutlineLevel无法逐段获取有效信息
• 使用Like运算符时，通过paragraph.Range.Text无法准确识别纯编号标题

初始代码框架 #

Dim doc As Document
Dim para As Paragraph
Dim lastNumericHeading As String
Dim textWithHeading As String

Dim finalText As String
Dim finalHeadings As String

Dim textArr() As String 
Dim headingsArr() As String

Dim isNumberedHeading As Boolean

Set doc = ActiveDocument
textWithHeading = ""
lastNumericHeading = ""
finalText = ""
finalHeadings = ""

' 获取所有文本和标题
For Each para in Doc.Paragraphs
    isNumberedHeading = helperFunction() ' 根据需要传入参数
    If isNumberedHeading Then
        ' TODO: 更新最近的编号标题
    Else
        finalText = finalText & "," & para.Range.Text
        finalHeadings = finalHeadings & "," & lastNumericHeading
    End If
Next Para

' 转换为数组
textArr = Split(finalText, ",")
headingArr = Split(finalHeadings, ",")

' 打印文本及关联标题
For i = LBound(textArr) To UBound(textArr)
    Debug.Print headingArr(i)
    Debug.Print textArr(i)
Next i

辅助函数框架：

Function helperFunction() As Boolean' 根据需要传入参数
    ' TODO: 实现判断逻辑
End Function

可行代码实现 #

以下是经过验证的完整VBA代码（@taller的方案同样有效）：

Sub ExtractTextWithHeadings()
    Dim doc As Document
    Dim para As Paragraph
    Dim lastNumericHeading As String
    Dim textWithHeading As String

    Dim finalText As String
    Dim finalHeadings As String

    Dim textArr() As String
    Dim headingArr() As String

    Dim isNumberedHeading As Boolean

    Set doc = ActiveDocument
    textWithHeading = ""
    lastNumericHeading = ""
    finalText = ""
    finalHeadings = ""

    ' 获取所有文本和标题
    For Each para In doc.Paragraphs
        isNumberedHeading = IsNumberedHeading(para)
        If isNumberedHeading Then
            lastNumericHeading = para.Range.ListFormat.ListString
        Else
            finalText = finalText & "," & para.Range.Text
            finalHeadings = finalHeadings & "," & lastNumericHeading
        End If
    Next para

    ' 转换为数组
    textArr = Split(finalText, ",")
    headingArr = Split(finalHeadings, ",")

    ' 打印文本及关联标题
    For i = LBound(textArr) To UBound(textArr)
        Debug.Print headingArr(i)
        Debug.Print textArr(i)
    Next i
End Sub

Function IsNumberedHeading(para As Paragraph) As Boolean
    ' 根据大纲级别判断是否为编号标题
    Dim outlineLevel As Integer
    outlineLevel = para.Range.ListFormat.ListLevelNumber
    
    ' 大纲级别大于1时判定为编号标题
    IsNumberedHeading = (outlineLevel > 1)
End Function

内容的提问来源于stack exchange，提问作者Ethan Anderson