How to get Last Key or Key-Combo Pressed (Not Event)

[Paul_Hossler]

How can you tell if it's a Shifted-q?

Now if I run the loop, the pressing the shift key get's 'peeked'

Option Explicit
' 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 posted
    pt 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 = Application.hWnd
    ' 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)
        '... 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 = msgMessage.wParam
    End If
End Function
 
Sub test()
    Dim i As Long
    Dim s As String
    s = ""
    i = 1
    Do While Len(s) = 0
        ActiveSheet.Cells(i, 1).Value = i
        i = i + 1
        s = CheckKeyboardBuffer
    Loop
    MsgBox s
End Sub

Paul