highlight current line of word document when move up or down

问题

I wanted to develop a program such a way that when up or down arrow moved, highlight the entire line of text. So when I go up or down with arrow keys it highlight the line where my cursor is.

So I developed this code.

Application.ScreenUpdating = False

Dim currentPosition As Range
Set currentPosition = Selection.Range 'pick up current cursor position

Selection.WholeStory
Selection.Range.HighlightColorIndex = wdNoHighlight


currentPosition.Select 'return cursor to original position

Selection.Range.HighlightColorIndex = wdYellow

Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend

Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.EndOf

Application.ScreenUpdating = True

Then I tried to assign this macro to both Up arrow key and Down arrow key. Then I realised that we can't assign one macro for 2 key combinations. So I created 2 macros like this. (Content is same. Only name is different.). And assigned SelectLineUp to Up arrow key and assigned SelectLineDown to down arrow key.

Sub SelectLineUp()

Application.ScreenUpdating = False

Dim currentPosition As Range
Set currentPosition = Selection.Range 'pick up current cursor position

Selection.WholeStory
Selection.Range.HighlightColorIndex = wdNoHighlight


currentPosition.Select 'return cursor to original position

Selection.Range.HighlightColorIndex = wdYellow

Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend

Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.EndOf


Application.ScreenUpdating = True


End Sub

And this is for down arrow

Sub SelectLineDown()

Application.ScreenUpdating = False

Dim currentPosition As Range
Set currentPosition = Selection.Range 'pick up current cursor position

Selection.WholeStory
Selection.Range.HighlightColorIndex = wdNoHighlight


currentPosition.Select 'return cursor to original position

Selection.Range.HighlightColorIndex = wdYellow

Selection.HomeKey Unit:=wdLine
Selection.EndKey Unit:=wdLine, Extend:=wdExtend

Selection.Range.HighlightColorIndex = wdYellow

'Unselect the line
Application.Selection.EndOf

Application.ScreenUpdating = True

End Sub

Now the problem is when I press down arrow in the keybord it works as I intended. But when I press Up arrow, it still goes down dirrenction in the document. Highly appreciate if you can tell me what I have done wrong.

回答1:

The following works for me. I used some additional methods for changing the Selection (or Range) locations, such as MoveEnd, MoveStart and Collapse. Note the change for the highlight setting of the entire document, so that you don't have to change the Selection.

If you use F8 to step through the code, and switch between the VBA Editor and document windows, you can see how these methods work. The details can be found in the VBA Help.

Sub SelectLineUp()
    Application.ScreenUpdating = False
    ActiveDocument.content.HighlightColorIndex = wdNoHighlight

    Selection.MoveEnd wdLine, -1
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend

    Selection.Range.HighlightColorIndex = wdYellow

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

Sub SelectLineDown()
    Application.ScreenUpdating = False

    ActiveDocument.content.HighlightColorIndex = wdNoHighlight

    Selection.MoveStart wdLine, 1
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend

    Selection.Range.HighlightColorIndex = wdYellow

    'Unselect the line
    Application.Selection.Collapse wdCollapseStart

    Application.ScreenUpdating = True
End Sub

回答2:

Try this out. This works for me, while keeping the code very DRY.

Option Explicit

Private Declare Function GetKeyState Lib "user32.dll" (ByVal nKey As Long) As Integer

Public Sub KeyUpOrDown()
    Dim keyUp As Boolean
    keyUp = CBool(GetKeyState(vbKeyUp) And &H80) ' Was "keyup" pressed

    If (keyUp) Then
        Selection.MoveUp Unit:=wdLine
        Call HighlightLine
    Else
        Selection.MoveDown Unit:=wdLine
        Call HighlightLine
    End If

End Sub

Private Sub HighlightLine()
    Application.ScreenUpdating = False
    Dim currPosition As Range
    Set currPosition = Selection.Range

    ActiveDocument.Content.HighlightColorIndex = wdNoHighlight
    Selection.Expand Unit:=wdLine
    Selection.Range.HighlightColorIndex = wdYellow

    currPosition.Select

End Sub

Both trigger keys can be bounded to the public subroutine "KeyUpOrDown".

I like the way this works, because it has a native feel. As you hinted in your code, the selection point does not get collapsed to one side but it maintains it's original position while switching line.

Another big one is the simulated key press event using the external "user32.dll" library.

I hope you'd find it useful. Thank you.

来源：https://stackoverflow.com/questions/50982327/highlight-current-line-of-word-document-when-move-up-or-down