如何使用vba返回在word段落上方找到的第一个标题的值？

Question

我目前正在为 word 编写一个 vba 宏，它应该抓取文档中的所有 cmets 并将它们返回到一个新创建的 excel 文件中。我快完成了，但我遇到了段落指示的问题。我也想将段落对应的标题放在excel中。为此，我必须直接获取段落标题或在段落上方找到第一个与标题相关的格式。至少这些是我能想到的选择。知道如何最好地解决这个问题吗？

Sub exportComments()

Dim xlApp As Object
Dim xlWB As Object
Dim i As Integer, HeadingRow As Integer
Dim objPara As Paragraph
Dim objComment As Comment
Dim strSection As String
Dim strTemp
Dim myRange As Range
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add 'create a new workbook
With xlWB.Worksheets(1)
' Create Heading
    HeadingRow = 1
    .Cells(HeadingRow, 1).Formula = "Comment"
    .Cells(HeadingRow, 2).Formula = "Page"
    .Cells(HeadingRow, 3).Formula = "Paragraph"
    .Cells(HeadingRow, 4).Formula = "Commented part"
    .Cells(HeadingRow, 5).Formula = "Comment"
    .Cells(HeadingRow, 6).Formula = "Reviewer"
    .Cells(HeadingRow, 7).Formula = "Date"
    strSection = "preamble" 'all sections before "1." will be labeled as "preamble"
    strTemp = "preamble"
    If ActiveDocument.Comments.Count = 0 Then
        MsgBox ("No comments")
        Exit Sub
    End If
    For i = 1 To ActiveDocument.Comments.Count
        Set myRange = ActiveDocument.Comments(i).Scope
        strSection = ParentLevel(myRange.Paragraphs(1))
        'MsgBox strSection
        'Comment line
        .Cells(i + HeadingRow, 1).Formula = ActiveDocument.Comments(i).Index
        'Page number line
        .Cells(i + HeadingRow, 2).Formula = ActiveDocument.Comments(i).Reference.Information(wdActiveEndAdjustedPageNumber)
        'Paragraph indicator line
        .Cells(i + HeadingRow, 3).Formula = ActiveDocument.Comments(i).Scope.Paragraphs(1)
        'Commented part line
        .Cells(i + HeadingRow, 4).Formula = ActiveDocument.Comments(i).Scope.FormattedText
        'Comment value line
        .Cells(i + HeadingRow, 5).Formula = ActiveDocument.Comments(i).Range
        'Comment reviewer line
        .Cells(i + HeadingRow, 6).Formula = ActiveDocument.Comments(i).Author
        'Comment date line
        .Cells(i + HeadingRow, 7).Formula = Format(ActiveDocument.Comments(i).Date, "dd/MM/yyyy")
    Next i
End With
Set xlWB = Nothing
Set xlApp = Nothing
End Sub

Function ParentLevel(Para As Word.Paragraph) As String
    ' Finds the first paragraph of the current section
    Dim oSection As Section
    Dim iSection As Integer
    Dim lngPara As Long
    Dim oRng As Range, oPara As Range
        iSection = Para.Range.Information(wdActiveEndSectionNumber)
        Set oSection = ActiveDocument.Sections(iSection)
        Set oRng = oSection.Range
        For lngPara = 1 To oRng.Paragraphs.Count
            Set oPara = oRng.Paragraphs(lngPara).Range
            If Len(oPara) > 1 Then
                Exit For
            End If
        Next lngPara
        oPara.End = oPara.End - 1
        ParentLevel = oPara.Text
    End Function

所以想法是将段落标题放在 Headingrow 3 中。该解决方案必须适应不同的标题格式，因为我使用的文档通常具有自制的标题格式。我唯一可以依赖的是在样式名称中包含单词 header 的标题。任何帮助将不胜感激，当然我可以添加更多信息可能会丢失。

Answer 1

您走在正确的轨道上，并且似乎相当有能力编写 VBA，因此此答案更具建议性而非确定性。

在样式名称中标识“标题”可能是一种选择，但前提是您可以依赖样式正确命名以适应此。在变量不稳定（可能会发生不可预测的变化）的场景中，有一个通常不需要太多开发的解决方案：在运行宏时提示用户提供此信息！

在您的情况下，您提到标题通常具有自定义格式，您可以获取使用的格式并使用 UserForm 提示用户确定哪些格式用于段落标题。通过在文档中使用Styles，可以更轻松地在 VBA 中访问这些内容：

Sub getStyles()
    Dim UsedStyles As New Collection
    Dim pgf As Paragraph

    For Each pgf In ActiveDocument.Paragraphs
        UsedStyles.Add pgf.Style.NameLocal
    Next pgf
End Sub

这将遍历文档中的所有段落，并创建一个唯一列表 (Collection)，其中包含文档中使用的所有样式的名称。然后，您可以将其传递给带有 MultiSelect ListBox 的 UserForm，指示用户选择用于标题的样式。将用户选择返回到您的宏，并将其用作查找标题的比较。