Jaafar Tribak
Well-known Member
- Joined
- Dec 5, 2002
- Messages
- 9,806
- Office Version
- 2016
- Platform
- Windows
http://www.box.net/shared/ukx1l761taWorkbook demo
Hi all.
Ever wanted to have a keyPress event for worksheet cells just like those provided by ActiveX textbox controls so you can detect the keys as they are being typed in and act accordingly ?
Workarounds i've used so far involved using a keyboard hook, timers or continuos loops all of which tie up and slow down the application and can potentially crash the application if the project is reset while the code is running.
I've written this small dll whose bytes are stored within the workbook in a hidden worksheet. There is no need to register the dll (its all done on the fly) and more importantly the application seems to remain stable and no crashing is feared even if the code errors out or the VBE is reset !
The only requirement is that the Event procedure(OnKeyPress) MUST be located in the workbook module and MUST be Public to be seen by the dll code.
Code in the workbook module :
Tested on Excel 2007 Win 7 only. Any feedback is much appreciated.
Hi all.
Ever wanted to have a keyPress event for worksheet cells just like those provided by ActiveX textbox controls so you can detect the keys as they are being typed in and act accordingly ?
Workarounds i've used so far involved using a keyboard hook, timers or continuos loops all of which tie up and slow down the application and can potentially crash the application if the project is reset while the code is running.
I've written this small dll whose bytes are stored within the workbook in a hidden worksheet. There is no need to register the dll (its all done on the fly) and more importantly the application seems to remain stable and no crashing is feared even if the code errors out or the VBE is reset !
The only requirement is that the Event procedure(OnKeyPress) MUST be located in the workbook module and MUST be Public to be seen by the dll code.
Code in the workbook module :
Code:
Option Explicit
Private Const DCOM_DLL_PATH_NAME As String _
= "C:\WINDOWS\system32\DirectCOM.dll"
Private Const JAAFAR_DLL_PATH_NAME As String _
= "C:\KeyPressWatcher.dll"
'CreateObject-Replacement (FileBased)
Private Declare Function GETINSTANCE Lib "DirectCom" _
(FName As String, ClassName As String) As Object
Private Declare Function UNLOADCOMDLL Lib "DirectCom" _
(FName As String, ClassName As String) As Long
Private oKeyPressInstance As Object
'=================================================================
'KeyPress custom event.
'Event Procedure Must be PUBLIC !!! and located in the workbook module.
'Use the ByRef Cancel argument to prevent the drop operation.
'Allow only Alpha characters in cell A1 of Sheets("test")
Public Sub OnKeyPress _
(ByVal Target As Range, ByVal KeyCode As Long, ByRef Cancel As Boolean)
If ActiveSheet Is Sheets("test") Then
If Target.Address = Range("a1").Address Then
If IsNumeric(Chr(KeyCode)) Then
MsgBox "No numeric characters are allowed in the range : " & _
vbNewLine & Target.Address
Cancel = True
End If
End If
End If
End Sub
'=====================================================================
Private Sub Workbook_Open()
'Create the DirectCom & KeyPressWatcher dlls.
Call CreateDlls
'load an instance of the 'KeyPressWatcher.dll' Class.
Set oKeyPressInstance = _
GETINSTANCE(JAAFAR_DLL_PATH_NAME, "KeyPressClass")
If Not oKeyPressInstance Is Nothing Then
'start watching user key strokes.
Call oKeyPressInstance.Start(ThisWorkbook)
Else
MsgBox "Unable to load the " & _
"'KeyPressWatcher' dll.", vbInformation
End If
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not oKeyPressInstance Is Nothing Then
oKeyPressInstance.Finish
Set oKeyPressInstance = Nothing
End If
UNLOADCOMDLL JAAFAR_DLL_PATH_NAME, "KeyPressClass"
On Error Resume Next
If Len(Dir(JAAFAR_DLL_PATH_NAME)) <> 0 Then
Kill JAAFAR_DLL_PATH_NAME
End If
End Sub
'Create the 'DirectCom' & 'KeyPressWatcher' dll from the
'Bytes stored in the '"DllBytes" hidden worksheet.
Private Sub CreateDlls()
Dim Bytes() As Byte
Dim lFileNum As Integer
Dim aVar
Dim x As Long
On Error Resume Next
If Len(Dir(JAAFAR_DLL_PATH_NAME)) = 0 Then
With Worksheets("DllBytes")
aVar = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Value
End With
ReDim Bytes(LBound(aVar) To UBound(aVar))
For x = LBound(aVar) To UBound(aVar)
Bytes(x) = CByte(aVar(x, 1))
Next
lFileNum = FreeFile
Open JAAFAR_DLL_PATH_NAME For Binary As #lFileNum
Put #lFileNum, 1, Bytes
Close lFileNum
End If
If Len(Dir(DCOM_DLL_PATH_NAME)) = 0 Then
Erase Bytes
With Worksheets("dllBytes")
aVar = .Range(.Cells(1, 2), .Cells(.Rows.Count, 2).End(xlUp)).Value
End With
ReDim Bytes(LBound(aVar) To UBound(aVar))
For x = LBound(aVar) To UBound(aVar)
Bytes(x) = CByte(aVar(x, 1))
Next
lFileNum = FreeFile
Open DCOM_DLL_PATH_NAME For Binary As #lFileNum
Put #lFileNum, 1, Bytes
Close lFileNum
End If
End Sub
Last edited:
