在 Word VBA 中查找字体大小之间的文本答案

【问题标题】：Finding text between font sizes in Word VBA在 Word VBA 中查找字体大小之间的文本
【发布时间】：2020-02-29 13:21:53
【问题描述】：

我正在寻找 Word VBA 中字体大小之间的文本。我想知道是否有比我下面的代码更好的方法。

它查找最小字体大小，然后迭代，以 0.5 递增直到最大值。据我所知，没有办法搜索字体大小范围。

您可以忽略一些额外的匹配（它是无语义脚注引用匹配脚本的一部分）

Dim findResults As Scripting.Dictionary
Set findResults = CreateObject("Scripting.Dictionary")

Set contentRange = ActiveDocument.Content

' Find fonts between range

Dim min
min = 6

Dim max
max = 8

Dim currentFontSize
currentFontSize = min

Do While max >= currentFontSize

    Selection.HomeKey Unit:=wdStory
    Set contentRange = ActiveDocument.Content

    With contentRange.Find.Font
        .Size = currentFontSize
    End With

    With contentRange.Find.Font.Shading
        .ForegroundPatternColor = wdColorAutomatic
    End With

    With contentRange.Find
        .Text = "[0-9]{1,3}"
        .MatchWildcards = True
        .Wrap = wdFindStop
    End With

    contentRange.Find.Execute

    While contentRange.Find.Found
        If contentRange.Font.Position > 2 Then
            Set myRange = ActiveDocument.Range(start:=contentRange.start - 10, End:=contentRange.start + Len(contentRange.Text))
            findResults.Add contentRange.Text, Trim(Replace(myRange.Text, vbCr, ""))
        End If
        'Selection.MoveRight Unit:=wdCharacter, Count:=Len(contentRange.Text)
        contentRange.Collapse wdCollapseEnd
        contentRange.Find.Execute
    Wend

    currentFontSize = currentFontSize + 0.5

Loop

【问题讨论】：

标签： vba ms-word

【解决方案1】：

我的方法是查找文本的所有实例，然后在循环中测试字体大小。这样，您只需要进行两次字体大小测试 - .Font.Size > 5.5 和 .Font.Size

Dim FindResults As Scripting.Dictionary, Rng As Range
Set FindResults = CreateObject("Scripting.Dictionary")
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "[0-9]{1,3}"
    .Font.Shading.ForegroundPatternColor = wdColorAutomatic
    .Forward = True
    .MatchWildcards = True
    .Wrap = wdFindStop
    .Execute
  End With
  Do While .Find.Found = True
    If .Font.Size > 5.5 Then
      If .Font.Size < 9.5 Then
        If .Font.Position > 2 Then
          Set Rng = .Duplicate
          Rng.Start = Rng.Start - 10
          FindResults.Add .Text, Trim(Replace(Rng.Text, vbCr, ""))
        End If
      End If
    End If
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With

【讨论】：

我想知道是对字体大小进行多次搜索，还是搜索然后过滤是否会更快。对于可能包含数百或数千个数字的文档，您认为哪种方式最快？
这实际上取决于在您的字体范围内格式化的数字与在它之外格式化的数字的相对频率。只有测试会告诉我们。您可能还需要考虑数据在输出中的排序方式：您的代码按字体大小对它们进行排序；无论字体大小如何，我都会按顺序对它们进行排序。