[[20230802135956]]　『キーを押したとき連続入力を避けたい』（暑い）　ページの最後に飛ぶ

『キーを押したとき連続入力を避けたい』（暑い）

お世話になります。

うまく書けるかどうかわかりませんが，簡単なヒントやアドバイスで構いませんので，いただけるとうれしいです。

subではGetAsyncKeyStateを使って，Functionでは押されたかどうかの判定をさせるコードを作成して，左矢印を押したときに１，右矢印を押したときに０を表示させるコードを書いているのですが，左矢印を押し続けたり，「パパっ」といった感じで瞬間２度押しすると，作業内容が先へ飛んでしまいます。この誤作動を制御する（阻止する）ことはできないのでしょうか。

参考にしているコードは以下のものでございます。ヒントだけでも構いませんので，よろしくお願いいたします。

【引用元】
https://vbabeginner.net/getasynckeystate/

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Declare PtrSafe Function GetTickCount Lib "kernel32" () As Long

Sub GetAsyncKeyStateTest()

    Dim bEndFlg     As Boolean      '// ループ終了フラグ（True：ループ継続、False：ループ終了）
    Dim lStartTimer As Long         '// 基点時刻
    Dim sMsg        As String       '// 出力MSG

    '// ループ継続
    bEndFlg = True

    '// 基点時刻を取得
    lStartTimer = GetTickCount

    Do
        '// ループ終了フラグが「ループ終了」の場合
        If bEndFlg = False Then
            '// ループを抜ける
            Exit Do
        End If

        Dim bKeyA       As Boolean
        Dim bKeyShift   As Boolean

        sMsg = ""

        '// Qが押された場合
        If (ChkKeyPush(vbKeyQ) = True) Then
            '// ループ終了フラグを「ループ終了」に更新
            bEndFlg = False
            Debug.Print "Quit"
        End If

        '// Aが押された場合
        If (ChkKeyPush(vbKeyA) = True) Then
            bKeyA = True
        Else
            bKeyA = False
        End If

        '// Shiftが押された場合
        If (ChkKeyPush(vbKeyShift) = True) Then
            bKeyShift = True
        Else
            bKeyShift = False
        End If

        '// Aが押されていた場合
        If bKeyA = True Then
            sMsg = "A "
        End If
        '// Shiftが押されていた場合
        If bKeyShift = True Then
            sMsg = sMsg & "Shift "
        End If

        If sMsg <> "" Then
            Debug.Print sMsg
        End If

        '// Windowsに制御を渡す
        DoEvents

        '// 0.1秒経過するまでスリープ
        Do While GetTickCount - lStartTimer < 100
            '// CPUを休ませる（ループ処理にCPUが占有されないようにして負荷を下げる）
            Call Sleep(1)
        Loop

        '// 基点時刻を再取得
        lStartTimer = GetTickCount
    Loop
End Sub

Function ChkKeyPush(a_iKeyCode)

    '// 指定キーが押された
    If (GetAsyncKeyState(a_iKeyCode) And &H8000) Then
        ChkKeyPush = True
    '// 指定キーが押されていない
    Else
        ChkKeyPush = False
    End If
End Function

＜使用 Excel：Microsoft365、使用 OS：Windows11 ＞

 とりあえず思った事だけ... ^^;

 押し続けたり、瞬間２度押しを検出する必要があるのに0.1秒スリープは、
 さすがにあまりにも監視の間隔が広過ぎでしょうね。

 CPUを休ませるだけなら
 Call Sleep(1)
 だけで十分ですよ。
 1ミリ秒も待てば、何十万回分もの無駄ループを回避出来ます。
 しかも「Sleep(1)」と言っても現実には15ミリ秒程度は寝てますから ^^;

 肝心の対策の方ですが、
 >左矢印を押したときに１，右矢印を押したときに０を表示させるコードを書いている
 これの置かれている環境についてもう少し詳しく(というか具体的に)説明なさった方が良いと思います。

 ひょっとすると真正面から対策を考えるよりも、
 もっとイイ方法が出てくるかも知れませんから。

（白茶） 2023/08/02(水) 14:43:49

一般的には、様々なコントロールオブジェクトのキーイベントを使うように考えますが、
提示のコードを使わなければいけない理由は何でしょうか？
（tkit） 2023/08/02(水) 14:45:13

白茶さん

ご教示ありがとうございます。このあたりが（も）疎いところなのですが、

'Do While GetTickCount - lStartTimer < 100

   Call Sleep(1)
'Loop

つまりCall部分だけ残すということでしょうか？それで実際のコード（以下）を試してみたのですが、矢印を一回押すと複数作業が一気に生じてしまいます。このあたり知識がなくて申し訳ございません。ws1上に表示される内容について発言させ、正解か不正解を判定させるコードです（書き始めたばかりです）。

tkitさん
ご質問ありがとうございます。ボタンで判定させることも考えたのですが、キー操作のほうが解答者に見えないというのが理由でございます。可能な限り、左右矢印で対応をしたいと考えています（そうなると、左右矢印以外のキーが押されたときは無効（無視）という対策も必要ですね）。

Sub GetAsyncKeyStateTest()

    Dim lStartTimer As Long
    Dim k As Long
    Dim 終了フラグ    As Boolean
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    終了フラグ = True

    lStartTimer = GetTickCount

    ws1.Select

    k = 2

    Do Until k = 11
            ws1.Range("A2").Value = ws2.Cells(k, 1).Value

                If (判定(vbKeyLeft) = True) Then
                        ws2.Cells(k, 2).Value = 1
                        k = k + 1
                    ElseIf (判定(vbKeyRight) = True) Then
                        ws2.Cells(k, 2).Value = 0
                        k = k + 1
                End If

                DoEvents

                Do While GetTickCount - lStartTimer < 100
                    Call Sleep(1)
                Loop

                lStartTimer = GetTickCount
    Loop

    bEndFlg = True

    MsgBox "テスト終了"
end Sub

Function 判定(a_iKeyCode)

    If (GetAsyncKeyState(a_iKeyCode) And &H8000) Then
        判定 = True
    Else
        判定 = False
    End If
End Function

（暑い） 2023/08/02(水) 16:11:52

白茶さん、tkitさんからご教示いただき、いろいろと試していますが、キー操作だと見た目が美しくないかなと、今頃気づいてしまいました。ws1をアクティブにして操作しますと、矢印を押すたびにセルが移動しますね。。。
（暑い） 2023/08/02(水) 16:26:19

コメント返信：

[ 一覧(最新更新順) ]

[[20230802135956]] 『キーを押したとき連続入力を避けたい』（暑い） ページの最後に飛ぶ

[[20230802135956]]　『キーを押したとき連続入力を避けたい』（暑い）　ページの最後に飛ぶ