问题
Arun Singh gave a great answer to a similar question (Is there any event that fires when keys are pressed when editing a cell?). I want to set a flag to prevent execution of Selection_Change event if the user is scrolling with the arrow keys.
回答1:
It's pretty easy actually. I am demostrating it for UP and DOWN arrow key. You may add more to it like RIGHT/LEFT/TAB/ENTER etc... I have commented the part where you can add the keys.
Paste this in the worksheet code area
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If CancSelEvnt = False Then
'
'~~> Rest of the code for the Selection Change
'
Else
'~~> Only for demostration purpose. Remove Msgbox later
MsgBox "User pressed one of the navigation keys"
CancSelEvnt = False
End If
End Sub
Paste this in a module
Option Explicit
'~~> We need this as this will help us in cancelling the
'~~> Selection chnage event
Public CancSelEvnt As Boolean
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
Message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function WaitMessage Lib "user32" () As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
(ByRef lpMsg As MSG, ByVal hwnd As Long, _
ByVal wMsgFilterMin As Long, _
ByVal wMsgFilterMax As Long, _
ByVal wRemoveMsg As Long) As Long
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal hwnd As Long, _
ByVal wMsg As Long, _
ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const WM_CHAR As Long = &H102
Private bExitLoop As Boolean
Sub StartKeyWatch()
Dim msgMessage As MSG
Dim bCancel As Boolean
Dim iKeyCode As Integer
Dim lXLhwnd As Long
On Error GoTo errHandler:
Application.EnableCancelKey = xlErrorHandler
bExitLoop = False
lXLhwnd = FindWindow("XLMAIN", Application.Caption)
Do
WaitMessage
If PeekMessage _
(msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
iKeyCode = msgMessage.wParam
TranslateMessage msgMessage
PeekMessage msgMessage, lXLhwnd, WM_CHAR, _
WM_CHAR, PM_REMOVE
If iKeyCode = vbKeyBack Then SendKeys "{BS}"
If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
bCancel = False
'
'~~> This is the main part where we check what key is pressed
'
If iKeyCode = vbKeyDown Then '<~~ Down
SendKeys "{DOWN}"
CancSelEvnt = True
ElseIf iKeyCode = vbKeyUp Then '<~~ UP
SendKeys "{UP}"
CancSelEvnt = True
'
'~~> And so on for the rest of the navigation keys
'
Else
CancSelEvnt = False
End If
If bCancel = False Then
PostMessage _
lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
End If
End If
errHandler:
DoEvents
Loop Until bExitLoop
End Sub
Sub StopKeyWatch()
bExitLoop = True
End Sub
And here is something that you may need ;)
VBKey Code List
vbKeyLButton Left Mouse Button
vbKeyRButton Right Mouse Button
vnKeyCancel Cancel Key
vbKeyMButton Middle Mouse button
vbKeyBack Back Space Key
vbKeyTab Tab Key
vbKeyClear Clear Key
vbKeyReturn Enter Key
vbKeyShift Shift Key
vbKeyControl Ctrl Key
vbKeyMenu Menu Key
vbKeyPause Pause Key
vbKeyCapital Caps Lock Key
vbKeyEscape Escape Key
vbKeySpace Spacebar Key
vbKeyPageUp Page Up Key
vbKeyPageDown Page Down Key
vbKeyEnd End Key
vbKeyHome Home Key
vbKeyLeft Left Arrow Key
vbKeyUp Up Arrow Key
vbKeyRight Right Arrow Key
vbKeyDown Down Arrow Key
vbKeySelect Select Key
vbKeyPrint Print Screen Key
vbKeyExecute Execute Key
vbKeySnapshot Snapshot Key
vbKeyInsert Insert Key
vbKeyDelete Delete Key
vbKeyHelp Help Key
vbKeyNumlock Delete Key
vbKeyA through vbKeyZ are the key code constants for the alphabet
vbKey0 through vbKey9 are the key code constants for numbers
vbKeyF1 through vbKeyF16 are the key code constants for the function keys
vbKeyNumpad0 through vbKeyNumpad9 are the key code constants for the numeric key pad
Math signs are:
vbKeyMultiply - Multiplication Sign (*)
vbKeyAdd - Addition Sign (+)
vbKeySubtract - Minus Sign (-)
vbKeyDecimal - Decimal Point (.)
vbKeyDivide - Division sign (/)
vbKeySeparator - Enter (keypad) sign
And Of course THIS msdn link for the key codes.
回答2:
I need to adjust the above to work with Worksheet_Change and Tab key as basically when tab key is pressed then changes the Target (when A2 is edited and Tab key pressed, Change event shows cell B2) which I want to avoid.
I have changed the key part to:
If iKeyCode = vbKeyTab Then '<~~ Tab
SendKeys "{TAB}"
CancSelEvnt = True
Else
CancSelEvnt = False
End If<code>
but am struggling to get any result on that?
When I press Tab key then my Change event does not call Sub StartKeyWatch() at all. also calling Sub StartKeyWatch() from Worksheet_Change directly does not seem to be doing anything...
what am I missing here?
thanks, mkvarious
来源:https://stackoverflow.com/questions/21453681/can-i-capture-and-emulate-a-keydown-event-in-excel-vba