如何获取段落文本对应的标题

Question

我想获取所有文本并将其与相应的标题相关联。

例如，假设有以下Word文档

HEADING 1
text one
text two
SUBHEADING 1.1
text three
text four
text five
SUBHEADING 1.1.1
text six
text seven
text eight
HEADING 2
text nine
HEADING 2.1
text ten
...

我已经能够通过创建一个非常长的字符串并使用“，”作为分隔符来获取文本，然后将其转换为数组。 因此，当程序正在获取所有文本时，我想获取最后一个编号的标题/副标题，这样就可以将其关联起来：

[, text one, text two, text three]
[, 1       , 1,      , 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 = ""

' GET ALL TEXT AND HEADINGS
For Each para in Doc.Paragraphs
    isNumberedHeading = helperFunction() ' use arguments as needed
    If isNumberedHeading Then
        ' TODO: set lastNumericHeading
    Else
        finalText = finalText & "," & para.Range.Text
        finalHeadings = finalHeadings & "," & lastNumericHeading
    End If
Next Para

' CONVERT TO ARRAY
textArr = Split(finalText, ",")
headingArr = Split(finalHeadings, ",")

' PRINT TEXT WITH ASSOCIATED HEADING
For i = LBound(textArr) To UBound(textArr)
    Debug.Print headingArr(i)
    Debug.Print textArr(i)
Next i

辅助功能：

Function helperFunction() As Boolean' use arguments as needed
    ' TODO if required
End Function

Answer 1

• 标题样式的名称为

  Headeing 1

  、

  Headeing 2

  、

  Headeing 3

  。如果您使用不同的名称，请根据需要修改

  helperFunction

  。

Option Explicit
Sub demo()
    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 Variant
    Dim headingsArr As Variant
    Dim isNumberedHeading As Boolean
    Set doc = ActiveDocument
    textWithHeading = ""
    lastNumericHeading = ""
    finalText = ""
    finalHeadings = ""
    ' GET ALL TEXT AND HEADINGS
    For Each para In doc.Paragraphs
        isNumberedHeading = helperFunction(para) ' use arguments as needed
        If isNumberedHeading Then
            lastNumericHeading = para.Range.ListFormat.ListString
        Else
            finalText = finalText & "," & para.Range.Text
            finalHeadings = finalHeadings & "," & lastNumericHeading
        End If
    Next para
    ' CONVERT TO ARRAY
    textArr = Split(finalText, ",")
    headingsArr = Split(finalHeadings, ",")
    Dim i As Long
    ' PRINT TEXT WITH ASSOCIATED HEADING
    For i = LBound(textArr) To UBound(textArr)
        Debug.Print headingsArr(i), textArr(i)
    Next i
End Sub
Function helperFunction(oPara As Paragraph) As Boolean ' use arguments as needed
    helperFunction = False
    If Left(oPara.Style, 7) = "Heading" Then
        Dim sListStr As String
        sListStr = oPara.Range.ListFormat.ListString
        If Len(sListStr) > 0 Then
            If IsNumeric(Replace(sListStr, ".", "")) Then
                helperFunction = True
            End If
        End If
    End If
End Function

测试文件：

输出：

1.            Text 1
1.            Text 2
1.1.          Text 3
1.1.          Text 4
1.1.1.        Text 5
1.1.1.        Text 6
2.            Text 7
2.            Text 8
2.1.          Text 9
2.1.          Text 10