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