在Word VBA中获取文档中单词出现的章节
我有一个Word文档,其中有标题(H1,H2,H3等).在每一章中,都有类似这样的要求:
I have a word document in which I have Headers (H1, H2, H3, etc.). In some of each chapter, there are requirements like this :
对于每一项要求,我都有一张上面的表格.我使用正则表达式查找我的要求.
For each requirement, I have a table like the one above. I use a regular expression to find my requirements.
首先需要
我想将所有需求参考提取到一个Excel文件中,并知道它们在哪几章中(每个级别之间都带有"/",例如H1/H2/H3).
I would like to extract all the requirements references in an Excel file and know in which chapters they are (with "/" between each level like this H1 / H2 / H3).
我将在输出中输出这种Excel文件:
I will have in output this kind of Excel file :
我成功提取了所有需求参考,但没有提取它们的路径章节.
I succeed to extract all the requirements references but not the path chapter of them.
这是我编写的代码,它只能从称为简介"的书签中提取需求引用(以免考虑目录中的那些内容):
Here is the code I wrote and which works to extract requirements references only from a bookmark called "Introduction" (in order not to take into account those wich are in the table of content) :
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
第二个需求
在参考文献和说明旁边获取版本.
Get the version next to the reference and the description under.
预先感谢您的帮助
我终于找到了另一种方法.我在段落中循环播放:
I finally found another way to do this. I loop on the paragraphs :
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