I'm running MS Excel 2010. I'm trying to add code to my macro which will determine if any key is pressed now (or has been pressed recently), and then take necessary actions before shutting down.
I am using GetAsyncKeyState now, which seems to detect if a key is down right now, but seems buggy and wholly unable to detect if a key was pressed a moment ago when my macro was busy doing somthing else.
The code I am trying is below, but it it now working and results in excel 2010 completely shutting down every time I try to use it. Is this code no longer compatible with excel, or am I just totally doing this wrong?
Thank you very much,
Nate
[VBA]'Type to hold the coordinates of the mouse pointer
Private Type POINTAPI
x As Long
y As Long
End Type
'Type to hold the Windows message information
Private Type MSG
hWnd As Long 'the window handle of the app
message As Long 'the type of message (e.g. keydown)
wParam As Long 'the key code
lParam As Long 'not used
time As Long 'time when message postedpt As POINTAPI 'coordinate of mouse pointer
End Type
'Look in the message buffer for a message
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
'Translate the message from a key code to a ASCII code
Private Declare Function TranslateMessage Lib "user32" _
(ByRef lpMsg As MSG) As Long
'Windows API constants
Private Const WM_CHAR As Long = &H102
Private Const WM_KEYDOWN As Long = &H100
Private Const PM_REMOVE As Long = &H1
Private Const PM_NOYIELD As Long = &H2
'Check for a key press
Public Function CheckKeyboardBuffer() As String
'Dimension variables
Dim msgMessage As MSG
Dim hWnd As Long
Dim lResult As Long
'Get the window handle of this application
hWnd = ApphWnd
'See if there are any "Key down" messages
lResult = PeekMessage(msgMessage, hWnd, WM_KEYDOWN, _
WM_KEYDOWN, PM_REMOVE + PM_NOYIELD)
'If so ...
If lResult <> 0 Then
'... translate the key-down code to a character code,
'which gets put back in the message queue as a WM_CHAR
'message ...
lResult = TranslateMessage(msgMessage)[/LEFT]
'... and retrieve that WM_CHAR message
lResult = PeekMessage(msgMessage, hWnd, WM_CHAR, _
WM_CHAR, PM_REMOVE + PM_NOYIELD)
'Return the character of the key pressed,
'ignoring shift and control characters
CheckKeyboardBuffer = Chr$(msgMessage.wParam)
End If
End Function[/VBA]
Reply With Quote
