按向右或向左箭头时突出显示当前单词

Question

我想开发一个程序，当按下右箭头或左箭头时，当前单词会突出显示。因此，当我使用箭头键向左或向右移动时，光标所在的单词会突出显示。其中一部分我能够利用以下信息进行开发 highlight current line of word document when move up or down

对于我目前拥有的右箭头：

Sub SelectWordRight()
Application.ScreenUpdating = False

ActiveDocument.Content.HighlightColorIndex = wdNoHighlight

Selection.MoveStart wdWord, 1
Application.Selection.Words(1).Select

Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.Collapse wdCollapseStart

Application.ScreenUpdating = True
End Sub

左箭头

Sub SelectWordLeft()
Application.ScreenUpdating = False
ActiveDocument.Content.HighlightColorIndex = wdNoHighlight

Selection.MoveEnd wdWord, -1

Application.Selection.Words(1).Select
Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.StartOf
Application.ScreenUpdating = True
End Sub

效果很好。但是当有像左括号和右括号这样的边界字符的单词时，它只会突出显示括号。

例如考虑这个 - 我喜欢这个网站（stackoverflow）

当我按下其中一个箭头时，它适用于其他词。但是当涉及到 (stackoverflow) 时，它会分别突出显示 (, stackoverflow 和 )。那么有没有办法突出显示以空格分隔的单词？

在 Cindy 的回答的帮助下，我能够为这样的左箭头开发解决方案。

Sub SelectWordLeft()
Application.ScreenUpdating = False
ActiveDocument.Content.HighlightColorIndex = wdNoHighlight

Selection.MoveEnd wdWord, -1

Selection.MoveStartUntil " ", wdBackward
Selection.MoveEndUntil " ", wdForward
Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.StartOf
Application.ScreenUpdating = True
End Sub

但我仍然无法弄清楚如何将其转换为在右箭头中使用。当有 - : ) ( { }

之类的字符时，它会失败

Answer 1

这适用于右箭头，请检查一下。

Sub SelectWordRight()
    Application.ScreenUpdating = False

    ActiveDocument.Content.HighlightColorIndex = wdNoHighlight

MoveToStartOfANewWord:      ' I added this label also

    Selection.MoveStart wdWord, 1

    ' I Added this BLOCK over here
    '-----------------------------
    ' PURPOSE: Move to the start of a -
    ' word i.e. our definition of a word

    'Debug.Print "'" & Selection.Previous & "'" & _
                " - " & Asc(Selection.Previous)
    If (Asc(Selection.Previous) = 32) Or _
        (Asc(Selection.Previous) = 13) _
    Then
        'check 4 "space" then "paragraph"
        GoTo ItIsAtTheStartOfANewWord
    Else
        GoTo MoveToStartOfANewWord
    End If

ItIsAtTheStartOfANewWord:


    Application.Selection.Words(1).Select

    ' I Added this BLOCK over here
    '-----------------------------
    ' PURPOSE: To extend the selection
    ' till the begining of a new word

ExtendTillStartOfANewWord:

    'Debug.Print "'" & Selection.Characters.Last & "'" & _
                " - " & Asc(Selection.Characters.Last)
    If (Asc(Selection.Characters.Last) = 32) Or _
       (Asc(Selection.Characters.Last) = 13) _
    Then
        'Selection.MoveEndUntil Cset:=" "
        GoTo SelectionIsAtTheStartOfANewWord
    Else
        Selection.MoveEnd wdWord, 1
        GoTo ExtendTillStartOfANewWord
    End If

SelectionIsAtTheStartOfANewWord:


    Selection.Range.HighlightColorIndex = wdYellow

    'Unselect the line
    Application.Selection.Collapse wdCollapseStart

    Application.ScreenUpdating = True

End Sub

它看起来很多，但效果很好，尤其是在段落中断。我希望你可以修改它为左箭头。

Answer 2

您可以使用一个宏来执行此操作 - 可以将一个宏分配给多个键。

建议的方法使用MoveStartUntil 和MoveEndUntil 方法来扩展范围（或选择），直到遇到指定的字符集（在本例中为空格）。

Sub SelectWord()
    Dim rng As Word.Range    
    Application.ScreenUpdating = False

    ActiveDocument.content.HighlightColorIndex = wdNoHighlight
    Set rng = Selection.Range 
    rng.MoveStartUntil " ", wdBackward
    rng.MoveEndUntil " ", wdForward

    rng.HighlightColorIndex = wdYellow

    'Unselect the line
    rng.Select
    rng.Collapse wdCollapseStart

    Application.ScreenUpdating = True
End Sub