获取Word VBA中文档中出现单词的章节

Question

我有一个word文档，其中我有Headers（H1，H2，H3等）。在每章的一些章节中，有这样的要求：

对于每个要求，我都有一个类似上面的表。我使用正则表达式来查找我的要求。

首先需要

我想在Excel文件中提取所有需求引用，并知道它们在哪些章节中（每个级别之间的“/”，如H1 / H2 / H3）。

我将输出这种Excel文件：

我成功提取了所有需求引用，但没有提取它们的路径章节。

这是我编写的代码，它仅用于从名为“Introduction”的书签中提取需求引用（为了不考虑内容表中的那些）：

Sub Extract_Requirements()

    Set oExcel = CreateObject("excel.application")
    oExcel.Visible = True
    Set oWk = oExcel.Workbooks.Add

    'Headers of the Excel file
    oWk.Sheets(1).Range("A1") = "PATH"
    oWk.Sheets(1).Range("B1") = "ID"
    oWk.Sheets(1).Range("C1") = "VERSION"
    oWk.Sheets(1).Range("D1") = "REF"
    oWk.Sheets(1).Range("E1") = "LABEL"
    oWk.Sheets(1).Range("F1") = "DESCRIPTION"
    oWk.Sheets(1).Range("G1") = "CRITICALITY"
    oWk.Sheets(1).Range("H1") = "CATEGORY"
    oWk.Sheets(1).Range("I1") = "STATE"
    oWk.Sheets(1).Range("J1") = "CREATED_ON"
    oWk.Sheets(1).Range("K1") = "CREATED_BY"

    'Start inserting data in Excel file
    i = 2

    Set RegEx = New RegExp
    RegEx.Pattern = "([A-Za-z0-9]+_)+\d{3}"
    RegEx.IgnoreCase = True
    RegEx.Global = True

   'Move the cursor to the Introduction bookmark (useful not to get the requirements within the table of content)
   Selection.GoTo What:=wdGoToBookmark, Name:="Introduction"
   Selection.End = ActiveDocument.Content.End

   Dim matchCol As MatchCollection
   Set matchCol = RegEx.Execute(Selection.Range)

   For Each Match In matchCol
       'PATH de l'exigence
       'TODO

       'VERSION de l'exigence
       'TODO

       'LABEL de l'exigence
       oWk.Sheets(1).Range("E" & i) = Match.Value

       'DESCRIPTION de l'exigence
       'TODO

       'STATE
       oWk.Sheets(1).Range("I" & i) = "APPROVED"
       i = i + 1

    Next Match
End Sub

第二需要

获取参考和说明旁边的版本。

提前感谢您的帮助

Answer 1

我终于找到了另一种方法。我循环了段落：

For Each objPara In Selection.Paragraphs
    With objPara.Range
        sText = .Text
        sStyle = .ParagraphStyle

        'On détermine le style de l'élément courant s'il en a un
        If sStyle = "Titre 1;H1" Then
            If sH1 <> sText Then
                sH2 = ""
            End If
            sH1 = sText
        ElseIf sStyle = "Titre 2;H2" Then
            If sH2 <> sText Then
                sH3 = ""
            End If
            sH2 = sText
        ElseIf sStyle = "Titre 3;H3" Then
            sH3 = sText
        End If
        Set regMatch = RegEx.Execute(sText)
        IsAMatch = (regMatch.Count > 0)
        If IsAMatch Then
            'PATH de l'exigence
            sPath = sH1
            If sH2 <> "" Then
                sPath = sPath & " / " & sH2
            End If
            If sH3 <> "" Then
                sPath = sPath & " / " & sH3
            End If
        End If
    End With
Next