ExcelのVBAでキーコードを得る

先程のタイマーを応用しつつ、キーボード上で押されているキーを決まったセルに表示する。

フォーカスが無くても反応するところがおもしろい。

Public Declare Function SetTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Public Declare Function GetAsyncKeyState Lib "USER32" (ByVal vKey As Long) As Long

Sub TimerStartStop()
    Set c = ThisWorkbook.Worksheets(1).Cells(1, 2)
    If c.Value = "" Then
        c.Value = SetTimer(0&, 31000&, 50&, AddressOf getKey)
    Else
        KillTimer 0&, c.Value
        c.Value = ""
    End If
End Sub

Sub getKey()
    On Error Resume Next
    Set w = ThisWorkbook.Worksheets(1)
    If GetAsyncKeyState(37) <> 0 Then w.Cells(1, 1).Value = "left" Else w.Cells(1, 1).Value = ""
    If GetAsyncKeyState(38) <> 0 Then w.Cells(2, 1).Value = "up" Else w.Cells(2, 1).Value = ""
    If GetAsyncKeyState(39) <> 0 Then w.Cells(3, 1).Value = "right" Else w.Cells(3, 1).Value = ""
    If GetAsyncKeyState(40) <> 0 Then w.Cells(4, 1).Value = "down" Else w.Cells(4, 1).Value = ""
    If GetAsyncKeyState(32) <> 0 Then w.Cells(5, 1).Value = "space" Else w.Cells(5, 1).Value = ""
    If GetAsyncKeyState(78) <> 0 Then w.Cells(6, 1).Value = "n" Else w.Cells(6, 1).Value = ""
    If GetAsyncKeyState(88) <> 0 Then w.Cells(7, 1).Value = "x" Else w.Cells(7, 1).Value = ""
    If GetAsyncKeyState(90) <> 0 Then w.Cells(8, 1).Value = "z" Else w.Cells(8, 1).Value = ""
    If GetAsyncKeyState(17) <> 0 Then w.Cells(9, 1).Value = "ctrl" Else w.Cells(9, 1).Value = ""
    If GetAsyncKeyState(18) <> 0 Then w.Cells(10, 1).Value = "alt" Else w.Cells(10, 1).Value = ""
End Sub