在 MS Word 表格上方查找最近的标题

Question

我在 Microsoft Word 中以下列方式枚举表格：

Dim doc As Document, t As Table
Set doc = ActiveDocument
For Each t In doc.Tables
Next t

现在我想在表格上方找到最近的具有“标题 2”样式的段落，并将其文本放入变量中。如果可以在不更改文档中的选择焦点的情况下完成它，那就太好了。

我可以枚举文档中的段落，但是如何确定某个段落在某个表格之上？

Answer 1

我通过建立段落起始位置列表解决了这个问题：

Private Type CaptionRec
  Text As String
  EndPos As Long
End Type

Dim caps() As CaptionRec
Dim i As Long
Dim p As Paragraph
ReDim caps(0)
i = 0
For Each p In doc.Paragraphs
  If p.Style = "Überschrift 2" Then
    i = i + 1
    ReDim Preserve caps(i)
    caps(i).Text = TrimGarbageAtEnd(p.Range.Text)
    caps(i).EndPos = p.Range.Start 'Ok, this should be the end, not the start
  End If
Next p

... 并从数组中找到表格开始和“标题 2”段落之间的最小距离：

Public Function GetClosestCaption(tableStart As Long, ByRef caps() As CaptionRec) As String
  Dim cap As CaptionRec, distance As Long, minDistance As Long, res As String, i As Long
  minDistance = 2147483647 'Max long
  res = ""
  For i = LBound(caps) To UBound(caps)
    cap = caps(i)
    distance = tableStart - cap.EndPos
    If distance >= 0 Then
      If distance < minDistance Then
        minDistance = distance
        res = cap.Text
      End If
    End If
  Next i
  GetClosestCaption = res
End Function

例程在以下循环中被调用：

Public Sub MainRoutine()
  For Each t In doc.Tables
    If table_validity_criteria_go_here Then
      caption = GetClosestCaption(t.Range.Start, caps)
      For Each r In t.Rows
        'Enumerate rows
      Next r
    End If
  Next t
End Sub

Answer 2

另一种方法是颠倒逻辑。不是先处理表格再查找关联的标题，而是先找到标题再处理标题级别范围内的表格，例如：

Sub FindHeading2Ranges()
   Dim findRange As Range
   Dim headingRange As Range
   Set findRange = ActiveDocument.Content
   With findRange.Find
      .ClearFormatting
      .Forward = True
      .Wrap = wdFindStop
      .Format = True
      .Style = ActiveDocument.Styles(wdStyleHeading2)
      Do While .Execute
         Set headingRange = findRange.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
         If headingRange.Tables.Count > 0 Then
            ProcessTables headingRange, TrimGarbageAtEnd(findRange.text)
         End If
         findRange.Collapse wdCollapseEnd
      Loop
   End With
End Sub

Sub ProcessTables(headingRange As Range, caption As String)
   Dim t As Table
   For Each t In headingRange.Tables
      If table_validity_criteria_go_here Then
         For Each r In t.Rows
            'Enumerate rows
         Next r
      End If
   Next t
End Sub