[COLOR=#008000]'The 'OnKeyEx' SUB runs a specified procedure when a particular key
'or key combination is pressed while excel is in EDIT MODE.[/COLOR]
Option Explicit
Public Enum MODIFIER_KEY
MOD_ALT = &H1
MOD_CONTROL = &H2
MOD_SHIFT = &H4
MOD_WIN = &H8
End Enum
Type POINTAPI
x As Long
y As Long
End Type
#If VBA7 Then
Type MSG
hwnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Declare PtrSafe Function RegisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare PtrSafe Function UnregisterHotKey Lib "user32" (ByVal hwnd As LongPtr, ByVal id As Long) As Long
Declare PtrSafe Function WaitMessage Lib "user32" () As Long
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
Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr
Declare PtrSafe Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long
Declare PtrSafe Function GetForegroundWindow Lib "user32" () As LongPtr
Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long
Declare Function WaitMessage Lib "user32" () As Long
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
Declare Function GetFocus Lib "user32" () As Long
Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function GetForegroundWindow Lib "user32" () As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If
Public Sub OnKeyEx(ByVal vKeyCode As Integer, Optional ByVal ModifierKey As MODIFIER_KEY, Optional ByVal MacroName As String, Optional ApplyToRange As Range)
Const PM_NOREMOVE = &H0: Const WM_HOTKEY = &H312
Static lRet As Long
Dim tMsg As MSG, oTempRange As Range
On Error Resume Next
Application.EnableCancelKey = xlDisabled
If Not ApplyToRange Is Nothing Then
Set oTempRange = Union(ActiveCell, ApplyToRange)
If Err.Number = 0 Then
If oTempRange.Address <> ApplyToRange.Address Then
vKeyCode = 0
Else
lRet = 0
End If
Else
vKeyCode = 0
End If
lRet = 0
End If
If vKeyCode = 0 Then
lRet = UnregisterHotKey(Application.hwnd, &HBFFF&)
Else
Do While lRet = 0
If GetForegroundWindow = FindWindow("wndclass_desked_gsk", vbNullString) Then Exit Do
Call RegisterHotKey(Application.hwnd, &HBFFF&, ModifierKey, vKeyCode)
Call WaitMessage
If PeekMessage(tMsg, Application.hwnd, WM_HOTKEY, WM_HOTKEY, PM_NOREMOVE) Then
If tMsg.wParam = &HBFFF& Then
CallByName ThisWorkbook, MacroName, VbMethod
End If
End If
DoEvents
Loop
End If
Call UnregisterHotKey(Application.hwnd, &HBFFF&)
End Sub