Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Is there any event that fires when keys are pressed when editing a cell?

Tags:

Is it in any way possible to capture events as you press a key in (make an edit to) a specific cell in a worksheet?

The closest one is know is the Change Event but that can only be activated as soon the edited cell is deselected. I want to capture the event while I'm editing the cell.

like image 518
Daan Avatar asked Jun 22 '12 09:06

Daan


1 Answers

Here is the answer, I have tested the same and it is working properly for me.

Track the Keypress in Excel

Interesting Question: MS Excel's Worksheet_Change event always fired, when you are done with your changes and getting out of the cell. To trap the Key Press event. Tracking of Keypress event is not possible with excel standard or built-in functions.

This can be achieved by using the API.

Option Explicit  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 TrackKeyPressInit()      Dim msgMessage As MSG     Dim bCancel As Boolean     Dim iKeyCode As Integer     Dim lXLhwnd As Long      On Error GoTo errHandler:         Application.EnableCancelKey = xlErrorHandler         'initialize this boolean flag.         bExitLoop = False         'get the app hwnd.         lXLhwnd = FindWindow("XLMAIN", Application.Caption)     Do         WaitMessage         'check for a key press and remove it from the msg queue.         If PeekMessage _             (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then             'strore the virtual key code for later use.             iKeyCode = msgMessage.wParam            'translate the virtual key code into a char msg.             TranslateMessage msgMessage             PeekMessage msgMessage, lXLhwnd, WM_CHAR, _             WM_CHAR, PM_REMOVE            'for some obscure reason, the following           'keys are not trapped inside the event handler             'so we handle them here.             If iKeyCode = vbKeyBack Then SendKeys "{BS}"             If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"            'assume the cancel argument is False.             bCancel = False             'the VBA RaiseEvent statement does not seem to return ByRef arguments             'so we call a KeyPress routine rather than a propper event handler.             Sheet_KeyPress _             ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel             'if the key pressed is allowed post it to the application.             If bCancel = False Then                 PostMessage _                 lXLhwnd, msgMessage.Message, msgMessage.wParam, 0             End If         End If errHandler:         'allow the processing of other msgs.         DoEvents     Loop Until bExitLoop  End Sub  Sub StopKeyWatch()      'set this boolean flag to exit the above loop.     bExitLoop = True  End Sub   '\\This example illustrates how to catch worksheet '\\Key strokes in order to prevent entering numeric '\\characters in the Range "A1:D10" . Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _                            ByVal KeyCode As Integer, _                            ByVal Target As Range, _                            Cancel As Boolean)      Const MSG As String = _     "Numeric Characters are not allowed in" & _     vbNewLine & "the Range:  """     Const TITLE As String = "Invalid Entry !"      If Not Intersect(Target, Range("A1:D10")) Is Nothing Then         If Chr(KeyAscii) Like "[0-9]" Then             MsgBox MSG & Range("A1:D10").Address(False, False) _             & """ .", vbCritical, TITLE             Cancel = True         End If     End If  End Sub 
like image 56
Arun Singh Avatar answered Sep 22 '22 18:09

Arun Singh