HOME > エクセルVBA > サンプル > GetAsyncKeyState

GetAsyncKeyState


【ファイル名】GetAsyncKeyState.xlsm
【バージョン】Ver 1.0.0.0
【作成日】2019年06月30日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】GetAsyncKeyState.zip
【説明】Windows APIの GetAsyncKeyState 関数で押したキーを表示するサンプルです。
画面

【外部リンク】Windows > Apps > Win32 > API > Keyboard and Mouse Input > Winuser.h > GetAsyncKeyState function
【外部リンク】Windows > Apps > Win32 > API > System Services > Synchapi.h > Sleep function
【外部リンク】Windows > Apps > Win32 > API > Desktop Technologies > Desktop App User Interface > User Interaction > Legacy Features > Keyboard and Mouse Input > Virtual-Key Codes
【外部リンク】Docs Office > VBA リファレンス > 言語リファレンス > リファレンス > 定数 > Keycode 定数


customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="GetAsyncKeyState">
          <button id="ShowFormButton" label="フォームを表示" keytip="S"
                  supertip="フォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

UserForm1
Option Explicit

' GetAsyncKeyState
Const VK_KANA = 21 ' カナ/かな
Const VK_CONVERT = 28 ' 変換
Const VK_NONCONVERT = 29 ' 無変換
Const VK_OEM_AUTO = 243 ' 半角/全角

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/win32/api/winuser/nf-winuser-getasynckeystate
  Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  
  ' https://docs.microsoft.com/en-us/windows/win32/api/synchapi/nf-synchapi-sleep
  Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
  Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Private Running As Boolean

Private Sub MoveLabel()
' Keycode 定数
' https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/keycode-constants
  Dim s As String
  
  Do
    s = ""
    If GetAsyncKeyState(VBA.KeyCodeConstants.vbKeyShift) Then s = s + "Shift + "
    If GetAsyncKeyState(vbKeyControl) Then s = s + "Ctrl + "
    If GetAsyncKeyState(vbKeyMenu) Then s = s + "Alt + "
    If GetAsyncKeyState(vbKeyLButton) Then s = s + "LButton "
    If GetAsyncKeyState(vbKeyRButton) Then s = s + "RButton "
    If GetAsyncKeyState(vbKeyMButton) Then s = s + "MButton "
    If GetAsyncKeyState(vbKeyCancel) Then s = s + "Cancel "
    If GetAsyncKeyState(vbKeyBack) Then s = s + "Back "
    If GetAsyncKeyState(vbKeyTab) Then s = s + "Tab "
    If GetAsyncKeyState(vbKeyClear) Then s = s + "Clear "
    If GetAsyncKeyState(vbKeyReturn) Then s = s + "Enter "
    If GetAsyncKeyState(vbKeyPause) Then s = s + "Pause "
    If GetAsyncKeyState(vbKeyCapital) Then s = s + "Capital "
    If GetAsyncKeyState(vbKeyEscape) Then s = s + "Escape "
    If GetAsyncKeyState(vbKeySpace) Then s = s + "Space "
    If GetAsyncKeyState(vbKeyPageUp) Then s = s + "PageUp "
    If GetAsyncKeyState(vbKeyPageDown) Then s = s + "PageDown "
    If GetAsyncKeyState(vbKeyEnd) Then s = s + "End "
    If GetAsyncKeyState(vbKeyHome) Then s = s + "Home "
    If GetAsyncKeyState(vbKeyLeft) Then s = s + "Left "
    If GetAsyncKeyState(vbKeyUp) Then s = s + "Up "
    If GetAsyncKeyState(vbKeyRight) Then s = s + "Right "
    If GetAsyncKeyState(vbKeyDown) Then s = s + "Down "
    If GetAsyncKeyState(vbKeySelect) Then s = s + "Select "
    If GetAsyncKeyState(vbKeyPrint) Then s = s + "Print "
    If GetAsyncKeyState(vbKeyExecute) Then s = s + "Execute "
    If GetAsyncKeyState(vbKeySnapshot) Then s = s + "Snapshot "
    If GetAsyncKeyState(vbKeyInsert) Then s = s + "Insert "
    If GetAsyncKeyState(vbKeyDelete) Then s = s + "Delete "
    If GetAsyncKeyState(vbKeyHelp) Then s = s + "Help "
    If GetAsyncKeyState(vbKey0) Then s = s + "0 "
    If GetAsyncKeyState(vbKey1) Then s = s + "1 "
    If GetAsyncKeyState(vbKey2) Then s = s + "2 "
    If GetAsyncKeyState(vbKey3) Then s = s + "3 "
    If GetAsyncKeyState(vbKey4) Then s = s + "4 "
    If GetAsyncKeyState(vbKey5) Then s = s + "5 "
    If GetAsyncKeyState(vbKey6) Then s = s + "6 "
    If GetAsyncKeyState(vbKey7) Then s = s + "7 "
    If GetAsyncKeyState(vbKey8) Then s = s + "8 "
    If GetAsyncKeyState(vbKey9) Then s = s + "9 "
    If GetAsyncKeyState(vbKeyA) Then s = s + "A "
    If GetAsyncKeyState(vbKeyB) Then s = s + "B "
    If GetAsyncKeyState(vbKeyC) Then s = s + "C "
    If GetAsyncKeyState(vbKeyD) Then s = s + "D "
    If GetAsyncKeyState(vbKeyE) Then s = s + "E "
    If GetAsyncKeyState(vbKeyF) Then s = s + "F "
    If GetAsyncKeyState(vbKeyG) Then s = s + "G "
    If GetAsyncKeyState(vbKeyH) Then s = s + "H "
    If GetAsyncKeyState(vbKeyI) Then s = s + "I "
    If GetAsyncKeyState(vbKeyJ) Then s = s + "J "
    If GetAsyncKeyState(vbKeyK) Then s = s + "K "
    If GetAsyncKeyState(vbKeyL) Then s = s + "L "
    If GetAsyncKeyState(vbKeyM) Then s = s + "M "
    If GetAsyncKeyState(vbKeyN) Then s = s + "N "
    If GetAsyncKeyState(vbKeyO) Then s = s + "O "
    If GetAsyncKeyState(vbKeyP) Then s = s + "P "
    If GetAsyncKeyState(vbKeyQ) Then s = s + "Q "
    If GetAsyncKeyState(vbKeyR) Then s = s + "R "
    If GetAsyncKeyState(vbKeyS) Then s = s + "S "
    If GetAsyncKeyState(vbKeyT) Then s = s + "T "
    If GetAsyncKeyState(vbKeyU) Then s = s + "U "
    If GetAsyncKeyState(vbKeyV) Then s = s + "V "
    If GetAsyncKeyState(vbKeyW) Then s = s + "W "
    If GetAsyncKeyState(vbKeyX) Then s = s + "X "
    If GetAsyncKeyState(vbKeyY) Then s = s + "Y "
    If GetAsyncKeyState(vbKeyZ) Then s = s + "Z "
    If GetAsyncKeyState(vbKeyNumpad0) Then s = s + "Numpad0 "
    If GetAsyncKeyState(vbKeyNumpad1) Then s = s + "Numpad1 "
    If GetAsyncKeyState(vbKeyNumpad2) Then s = s + "Numpad2 "
    If GetAsyncKeyState(vbKeyNumpad3) Then s = s + "Numpad3 "
    If GetAsyncKeyState(vbKeyNumpad4) Then s = s + "Numpad4 "
    If GetAsyncKeyState(vbKeyNumpad5) Then s = s + "Numpad5 "
    If GetAsyncKeyState(vbKeyNumpad6) Then s = s + "Numpad6 "
    If GetAsyncKeyState(vbKeyNumpad7) Then s = s + "Numpad7 "
    If GetAsyncKeyState(vbKeyNumpad8) Then s = s + "Numpad8 "
    If GetAsyncKeyState(vbKeyNumpad9) Then s = s + "Numpad9 "
    If GetAsyncKeyState(vbKeyMultiply) Then s = s + "* "
    If GetAsyncKeyState(vbKeyAdd) Then s = s + "+ "
    If GetAsyncKeyState(vbKeySeparator) Then s = s + "Separator "
    If GetAsyncKeyState(vbKeySubtract) Then s = s + "- "
    If GetAsyncKeyState(vbKeyDecimal) Then s = s + ". "
    If GetAsyncKeyState(vbKeyDivide) Then s = s + "/ "
    If GetAsyncKeyState(vbKeyF1) Then s = s + "F1 "
    If GetAsyncKeyState(vbKeyF2) Then s = s + "F2 "
    If GetAsyncKeyState(vbKeyF3) Then s = s + "F3 "
    If GetAsyncKeyState(vbKeyF4) Then s = s + "F4 "
    If GetAsyncKeyState(vbKeyF5) Then s = s + "F5 "
    If GetAsyncKeyState(vbKeyF6) Then s = s + "F6 "
    If GetAsyncKeyState(vbKeyF7) Then s = s + "F7 "
    If GetAsyncKeyState(vbKeyF8) Then s = s + "F8 "
    If GetAsyncKeyState(vbKeyF9) Then s = s + "F9 "
    If GetAsyncKeyState(vbKeyF10) Then s = s + "F10 "
    If GetAsyncKeyState(vbKeyF11) Then s = s + "F11 "
    If GetAsyncKeyState(vbKeyF12) Then s = s + "F12 "
    If GetAsyncKeyState(vbKeyF13) Then s = s + "F13 "
    If GetAsyncKeyState(vbKeyF14) Then s = s + "F14 "
    If GetAsyncKeyState(vbKeyF15) Then s = s + "F15 "
    If GetAsyncKeyState(vbKeyF16) Then s = s + "F16 "
    If GetAsyncKeyState(vbKeyNumlock) Then s = s + "Numlock "
'    If GetAsyncKeyState(VK_KANA) Then s = s + "カナ/かな " '
    If GetAsyncKeyState(VK_CONVERT) Then s = s + "変換 " '
    If GetAsyncKeyState(VK_NONCONVERT) Then s = s + "無変換 " '
'    If GetAsyncKeyState(VK_OEM_AUTO) Then s = s + "半角/全角 " '
    
    Label1.Caption = s
    Sleep 1
    DoEvents
  Loop While Running
End Sub

Private Sub UserForm_Activate()
  Call MoveLabel
End Sub

Private Sub UserForm_Initialize()
  Running = True
End Sub

Private Sub UserForm_Terminate()
  Running = False
End Sub
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  
  Select Case control.ID
    Case "ShowFormButton"
      UserForm1.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  
  Exit Sub
  
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上