Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
#If VBA7 Then
Private Type MSG
hWnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Private Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hWnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hWnd As LongPtr, ByVal id As Long) As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
#Else
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 RegisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Private Declare Function UnregisterHotKey Lib "user32" (ByVal hWnd As Long, ByVal id As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hWnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
#End If
Private Const MOD_ALT = &H1
Private Const MOD_CONTROL = &H2
Private Const MOD_SHIFT = &H4
Private Const PM_REMOVE = &H1
Private Const WM_HOTKEY = &H312
Private bCancel As Boolean
Private Sub UserForm_Activate()
'============================================================
'run any other pre-existing code here before hooking the keys.
'============================================================
'Hook the Alt + 1 keys combination.
bCancel = False
Call RegisterHotKey(Application.hWnd, &HBFFF&, MOD_ALT, vbKey1)
Call RegisterHotKey(Application.hWnd, &HBFFF&, MOD_ALT, vbKeyNumpad1)
Call RegisterHotKey(Application.hWnd, &HBFFE&, MOD_ALT, vbKey2)
Call RegisterHotKey(Application.hWnd, &HBFFE&, MOD_ALT, vbKeyNumpad2)
Call Key_Listener
End Sub
Private Sub Key_Listener()
Dim message As MSG
On Error GoTo Oops
Do While Not bCancel
WaitMessage
If PeekMessage(message, Application.hWnd, WM_HOTKEY, WM_HOTKEY, PM_REMOVE) Then
'=========================================================
'Comment out this line if you don't wish to activate excel.
'VBA.AppActivate Application.Caption
'=========================================================
Select Case message.wParam
Case &HBFFF&
'Execute the 'Test' procedure.
Call Test
Case &HBFFE&
Call Test2
End Select
End If
DoEvents
Loop
Oops:
Call UnregisterHotKey(Application.hWnd, &HBFFF&)
Call UnregisterHotKey(Application.hWnd, &HBFFE&)
End Sub
Sub Test()
Sheet1.Cells(1).Value = Sheet1.Cells(1).Value + 1
End Sub
Sub Test2()
Sheet1.Cells(2).Value = Sheet1.Cells(2).Value + 5
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bCancel = True
End Sub
