Question

我正在寻找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

Answer 1

我的方法是找到文本的所有实例，然后在循环中测试字体大小。这样，您只需要执行两个字体大小测试-.Font.Size> 5.5和.Font.Size <8.5。尝试根据以下方法进行尝试：

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

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

1 个答案: