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

如何解决在 MS Word 表格上方查找最近的标题

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

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

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

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

解决方法

我通过建立一个段落开始位置列表来解决这个问题：

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

,

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

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