范围不在选择范围内

Question

我正在开发一个在选定范围内突出标点符号的宏。

图片中的第一个示例显示了荧光笔在第一行文本上运行时的外观。 When a normally sized area is selected, it works as intended and highlights the punctuation within the selection.

图像中的第二个示例显示了未选择范围时荧光笔的作用，但光标位于第二行文本开头的“a”之前的右侧。请注意，范围是失控的，并选择了光标之后的所有内容。

图像中的第三个示例显示了当范围为 ONE SPACE 时荧光笔的作用。在这个例子中，我选择了第二行开头的“a”之后的右括号；换句话说，所选范围是从括号的开头到结尾。请注意，该范围是失控的，但在第二行上方和下方的两个方向上：它已在整个文档上运行。

示例

Sub Review_Highlighter()

''Initialize variables
Dim strKey As Variant
Dim d As Object

'Instantiate Dictionary object "d" for punctuation to highlight
Set d = CreateObject("Scripting.Dictionary")

' Clear existing formatting and settings in Find and Replace fields
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Application.ScreenUpdating = False

'Add dictionary values
'd.Add "[Text To Replace]", "[Replacement Text]"
d.Add "(", "("
d.Add ")", ")"
d.Add "[", "["
d.Add "]", "]"
d.Add "{", "{"
d.Add "}", "}"
d.Add ".", "."
d.Add ",", ","
d.Add ";", ";"
d.Add ":", ":"
d.Add "-", "-"
d.Add "+", "+"
d.Add "_", "_"
d.Add "%", "%"
d.Add "#", "#"
d.Add "$", "$"
d.Add ">", ">"
d.Add "<", "<"
d.Add Chr(39), Chr(39)
d.Add Chr(173), Chr(173)
d.Add """", """"
d.Add "?", "?"
d.Add "!", "!"
d.Add "/", "/"
d.Add "\", "\"
d.Add "=", "="
d.Add "*", "*"
d.Add "<d", "d"
d.Add "<cl", "cl"
d.Add Chr(183), Chr(183)
d.Add "  ", "  "
d.Add "   ", "   "

'Get selection in the selection range
With Selection.range.Find
    .Format = True
    .MatchWholeWord = True
    .MatchAllWordForms = False
    .MatchWildcards = False
    .Wrap = wdFindStop
    .Forward = True
  
    'For each index number in each dictionary, replace text with same text highlighted,
    ' red for period, pink for comma, yellow for colon or semicolon,
    ' green for all other punctuation, and red for special words.
    'For each key in d, replace text with key value
    For Each strKey In d.Keys()
        .MatchWildcards = False
        .Text = strKey
        If .Text = "." Then
            Options.DefaultHighlightColorIndex = wdDarkRed
        ElseIf .Text = "," Then
            Options.DefaultHighlightColorIndex = wdPink
        ElseIf .Text = ";" Or .Text = ":" Then
            Options.DefaultHighlightColorIndex = wdYellow
        Else
            Options.DefaultHighlightColorIndex = wdBrightGreen
        End If
        If .Text = "<d" Or .Text = "<cl" Or .Text = "   " Or .Text = "  " Then
            Options.DefaultHighlightColorIndex = wdGray25
            .MatchWildcards = True
        End If
        .Replacement.Text = d(strKey)
        .Replacement.Highlight = True
        .Execute Replace:=wdReplaceAll
        .MatchWildcards = False
    Next
    
End With

'Deallocate memory
Set d = Nothing
Set strKey = Nothing

Application.ScreenUpdating = True

End Sub

我尝试用

启动一个范围对象

Dim RngSel As range
Set RngSel = Selection.range

并设置选择

'Get selection in the selection range
With ActiveDocument.range
    .Start = RngSel.Start
    .End = RngSel.End
    With .Find
        .Format = True
        .MatchWholeWord = True
        .MatchAllWordForms = False
        .MatchWildcards = False
        .Wrap = wdFindStop
        .Forward = True

它导致相同的情况，除了第二种和第三种情况，它选择整个文档。

我听说过 Word 中挑剔的动态选择范围，想知道我做错了什么，是否有任何解决方法可以缓解这个问题。

Answer 1

试试：

Sub Demo()
Application.ScreenUpdating = False
Dim StrFnd As String, i As Long
StrFnd = "[\!-/\:-\?\[-`\{-\}‘-”·­]|[\:\;]|.|,|[ ]{2,}|<d|<cl"
With Selection
  If .Type = wdSelectionIP Then Exit Sub
  If InStr(Trim(.Text), " ") = 0 Then Exit Sub
  With .Range.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Replacement.Text = "^&"
    .Replacement.Highlight = True
    For i = 0 To UBound(Split(StrFnd, "|"))
      Select Case i
        Case 0: Options.DefaultHighlightColorIndex = wdBrightGreen
        Case 1: Options.DefaultHighlightColorIndex = wdYellow
        Case 2: Options.DefaultHighlightColorIndex = wdDarkRed
        Case 3: Options.DefaultHighlightColorIndex = wdPink
        Case 4 - 6: Options.DefaultHighlightColorIndex = wdGray25
      End Select
      .Text = Split(StrFnd, "|")(i)
      .Execute Replace:=wdReplaceAll
    Next
  End With
End With
Application.ScreenUpdating = True
End Sub