GetAsyncKeyState(32) の動作が分からない

長くてすみません。　マクロで連続実行させているループを、キー操作で抜けたいのです。
例①のようなコードですと、｢Return｣｢スペースキー｣のいずれかでループを抜けられました。
例①
Sub 例１()
Do While ek = 0
ek = Eky(): DoEvents: Sleep 8　 ' スペースの場合に 32を返す Returnの場合に 13を返す
Cells(12, 3) = WorksheetFunction.RandBetween(8, 976)
Loop
j = ek: Cells(13, 3) = ek
End Sub

Function Eky() As Single
Const tky = -32768 ' スペース32　エンター13で戻す
Eky = 0
If (GetAsyncKeyState(13) And tky) = tky Then
Eky = 13
ElseIf (GetAsyncKeyState(32) And tky) = tky Then
Eky = 32
End If
End Function

下のコードですと、｢Return｣は期待通りです。
｢スペース｣を押したときには期待通りの動作をしたりするときもあるのですが、Stopで止まらず、《単にマクロが終了し》、マクロ実行直前に選択していたExcelシートのセルに｢スペースが入力された途中の状態｣で終わるのです。スペースを押す前のループの動作は正常に見えます。
例②
Sub Macro1()
Dim r, n, m, p As Integer, s As Integer, ti, ti1, ti2, ti3, ti4, i, k(150) As Integer
r = 0: m = 0: ek = 0:
p = Cells(1, 10): s = Cells(2, 10) ' pは 1回の角度　sはsleepミリセコンド
ti = miri秒(): Cells(1, 1) = kk5: Cells(7, 1) = kk4
For i = 0 To 150: k(i) = p: Next: i = 5
Do While m < 360
ti1 = miri秒()
m = m + 1: Cells(9, 6) = Int(m * p / 360)
ActiveSheet.Shapes.Range(Array("Group 8")).IncrementRotation k(i)
Cells(3, 15) = (Cells(3, 15) + k(i)) Mod 360
Cells(3, 1) = kk5: Cells(8, 1) = kk4
ek = Eky(): Cells(3, 10) = ek: DoEvents: Sleep s:
If ek = 32 Then Stop　　’　この位置でマクロの実行は止まらない
If Cells(3, 10) > 0 Then m = 9000:
Loop
Stop　　’　この位置でもマクロの実行は止まらない
End Sub

Function miri秒()
Call GetLocalTime(T)
' 現在日時取得Tを　 時刻以下ミリ秒までの数値にし,関数戻り値にする
' 注意　測定日を跨いでも忖度されない。年月日データを無視
kk1 = T.wHour: kk2 = T.wMinute: kk3 = T.wSecond: kk4 = T.wMilliseconds
kk4 = kk3 + kk4 / 1000
kk = kk1 * 3600 + kk2 * 60 + kk4: kk5 = kk1 & ":" & kk2 & ":" & kk3
miri秒 = kk
End Function

先頭に次も書いています。
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Declare PtrSafe Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Declare PtrSafe Function BeepAPI Lib "kernel32.dll" Alias "Beep" _
(ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

Type SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type

Public T As SYSTEMTIME
Public d, th, tm, ts, s, t1, t2, t3, t4, t5
Public kk, kk1, kk2, kk3, kk4, kk5

とにかく、何が原因なのかが不明なので、絶体関係ないはずのコード部分も上には入れてあります。
スペースキーのクリックでも、[ If ek = 32 Then Stop　　’　この位置でマクロの実行は止まらない]という位置で、きちんと、止まるようにしたいです。

スタート時の（時刻と、秒+ミリ秒）　実行中の（時刻と、秒+ミリ秒）を表示させ、
スペースかReturnでマクロを抜けて、実行時間をミリ秒単位で表示させています。
また、1秒に360度1回転する針の図形Array("Group 8")を表示しています。
最終的には、正確に0.97～1.03秒で1回転になるように、回転角度やsleep時間を、マクロ実行中に自動調整させたいと思っています。

質問者からの補足コメント

• 原因がわかりました。　①マクロをVBEで実行するときは問題ないのですが、EXCELシートの図形をクリックして｢登録してあるマクロ｣に実行を移すと、入力バッファーにクリックデータが残っている。②マクロ実行中にトラップのキー操作をすると、マクロがキャッチする1回分のキー値だけでなく、同じキー値が数回分残っているらしく、それが想定外の状況を引き起こす。
  で、次のように直したところ、｢この部分の処理｣については、期待通りになりました。
  　続きは　別の捕捉

    補足日時：2022/03/07 07:34

• 文字制限がきつすぎです。自己回答も出来ない？ので、新規質問を起こして、そこに現状の解決策を書きます。　もっと良い方法があったら、教えてください。

    補足日時：2022/03/07 07:40

• ここに　質問の形で投稿しました。
  https://oshiete.goo.ne.jp/qa/12838313.html

    補足日時：2022/03/07 08:37

No.1 ベストアンサー 回答者： Qchan1962 回答日時： 2022/03/03 00:38

こんばんは

回答ではありません。
ご質問文のコードを見ているだけで検証などを行っていませんが、
気になる点を、グローバル変数　s　が
Sub Macro1()
Dim r, n, m, p As Integer, s As Integer　となっていますが
問題は無いのでしょうか、、どうだったか、、

あと止めたいところですが
Function Eky() As Singleを返しているけれどSingleで合っていますか？
変数ek はSingle？　If ek = 32　は成立する？　Integerでは？
変数ekの宣言が見当たらないのですけれどSingle？

エラー無く動くなら良いのですが、Option Explicit　を使って
コンパイルして検証するのが良いのでは無いかと思いました。

No.6 回答者： Qchan1962 回答日時： 2022/03/05 14:52

必要情報を忘れました（挙動が変わります）

VBE（設定）エラートラップ　を　添付図で

No.5 回答者： Qchan1962 回答日時： 2022/03/05 14:26

すみません

添付忘れました

No.4 回答者： Qchan1962 回答日時： 2022/03/05 14:19

こんにちは

返信を受けて、、
Application.Interactive = False
Application.EnableCancelKey = xlDisabled
途中での対応処理が難しいのとデバッグには向きません。また、
windowsAPIの兼ね合いもあるでしょうし、確かにやめた方が良いですね。

＞Do While m < 360　は実行時間が短くないかな
これは、　＞sはsleepミリセコンドとあり
m は単なるカウント変数でループ内のSleep は　s　のみの為
360回ループするには時間がさしてかからないのではと思った為です

不完全（表示されていないだけかも）なコードで無限ループやスタックの可能性のあるコードを試すのは躊躇しましたが
実際に試さないと解らない部分がありましたので試しました。

Sub 例１()についてですが、確かに上手く行く事もありますが
Cells(13, 3) = ekが実行されない事もありました。
例、なので深堀するのはやめて本題のMacro1を検証する事とします

書き直したコードを示します
（変数宣言、不要変数削除、WindowsAPI GetAsyncKeyState Lib追加）

Option Explicit
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
Declare PtrSafe Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Type SYSTEMTIME
　 wYear As Integer
　 wMonth As Integer
　 wDayOfWeek As Integer
　 wDay As Integer
　 wHour As Integer
　 wMinute As Integer
　 wSecond As Integer
　 wMilliseconds As Integer
End Type
Public T As SYSTEMTIME
'とりあえずそのままVariantで
Public d, th, tm, ts, s, t1, t2, t3, t4, t5
Public kk, kk1, kk2, kk3, kk4, kk5

Sub Macro1()
Dim ek As Single
Dim ti As Single, ti1 As Single
Dim r As Integer, m As Integer, p As Integer, s As Integer
Dim i As Integer, k(150) As Integer
　 'マルチ防止
　 With ActiveSheet.Shapes("Button 1").TextFrame.Characters
　　 If .Text = "Macro1" Then
　　　　.Text = "実行中"
　　 Else
　　　　Exit Sub
　　 End If
　 End With
　 '出力セルクリアー
　 With ActiveSheet
　　 .Range("A1:A3,A7:A8,F9").ClearContents
　 'セル入力モードを防ぐ為の暫定処置
　　 .Shapes(2).Select
　 End With
　 'ご質問コード　（Stop＞Msgbox）
　 r = 0: m = 0: ek = 0:
　 p = Cells(1, 10): s = Cells(2, 10)　 ' pは 1回の角度　sはsleepミリセコンド
　 ti = miri秒(): Cells(1, 1) = kk5: Cells(7, 1) = kk4
　 For i = 0 To 150: k(i) = p: Next: i = 5
　 Do While m < 360
　　 ti1 = miri秒()
　　 m = m + 1: Cells(9, 6) = Int(m * p / 360)
　 '　　 ActiveSheet.Shapes.Range(Array("Group 8")).IncrementRotation k(i)
　　 Cells(3, 15) = (Cells(3, 15) + k(i)) Mod 360
　　 Cells(3, 1) = kk5: Cells(8, 1) = kk4
　　 ek = Eky(): Cells(3, 10) = ek: DoEvents: Sleep s:　 'ｓって1秒？
　　 If ek = 32 Then Stop　 '　MsgBox ("32")　この位置でマクロの実行は止まらない
　　 If Cells(3, 10) > 0 Then m = 9000:
　 Loop
　 MsgBox ("end")　　　 '　この位置でもマクロの実行は止まらない
　 'Stop 後　F5もしくはF8で下記を実行
　 ActiveSheet.Shapes("Button 1").TextFrame.Characters.Text = "Macro1"

End Sub
Function Eky() As Single
Const tky = -32768　　　 ' スペース32　エンター13で戻す
　 Eky = 0
　 If (GetAsyncKeyState(13) And tky) = tky Then
　　 Eky = 13
　 ElseIf (GetAsyncKeyState(32) And tky) = tky Then
　　 Eky = 32
　 End If
End Function
Function miri秒()
　 Call GetLocalTime(T)
　 ' 現在日時取得Tを　 時刻以下ミリ秒までの数値にし,関数戻り値にする
　 ' 注意　測定日を跨いでも忖度されない。年月日データを無視
　 kk1 = T.wHour: kk2 = T.wMinute: kk3 = T.wSecond: kk4 = T.wMilliseconds
　 kk4 = kk3 + kk4 / 1000
　 kk = kk1 * 3600 + kk2 * 60 + kk4: kk5 = kk1 & ":" & kk2 & ":" & kk3
　 miri秒 = kk
End Function

テストシートは添付図で
ボタンはフォームオブジェクト
Shapes(2)は直線コネクター
ボタンテキストで重複実行を抑止
A9セルに経過時間を関数で算出
テスト結果、必要箇所でStop　しました。

Shapes(2)を選択させなかった場合（推測した不具合原因を排除しない場合）
spaceを押下した時　VBEの　If ek = 32 Then Stop　で
⇒のみ表示でストップ　アクション（実行行移動など）をすると
プロジェクトのリセットダイアログが出力され　キャンセルを押すと
実行プロセスがStopへ移動し止まる。
VBE表示でも非表示でも同様の事象（If ek = 32 Then Stop文頭にスペースが入る）でした。（いずれもシート上のボタンからの実行）
＊APIのバックグランド処理は止めていません

検証OS、Office
Windows10 64bit Microsoft Office Home & Business 2013 32bit
の一部　Excel (15.0.5381.1000)

下記も所有していますが、未検証です
Microsoft Office Home and Business 2016 Premium
Microsoft Office Home & Business 2019
Microsoft 365 （会社）

あくまで私のローカルでの検証で再現できるかは分かりませんが
参考になれば、幸いです。

No.3 回答者： Qchan1962 回答日時： 2022/03/03 03:08

書き忘れましたので追記します

Sub 例１()　でループを抜けましたとありますが
これは多分、誤解です。
Returnの時は　Cells(13, 3) = ek　が実行され13が出力されますが
スペースキーの時はCells(13, 3) = ekが実行されません
DoEventsでアプリケーションにイベントが渡り、セル入力モードで
VBAの実行が中止されるのだと思います
（この辺りのインスタンスやエラーログなどがどうなっているのか素人なので良く分かりません）

この回答へのお礼

例1の実行前に、C13のセルをクリアして、例１を実行して、スペースキーを押すと、Cells(13, 3) = ekが実行されて、32の値が入ります。
その前後に何かのコードを書いても、そのコードは実行されます。

＞ DoEventsでアプリケーションにイベントが渡り、セル入力モードで
VBAの実行が中止されるのだと思います

実行中に、適当にキーを押しても、スペースキー、Returnキー、Escキー以外は、基本的に無視されます。
スペースキー、Returnキー、Escキー以外では、マクロはループ内を実行し続け、Cells(12, 3) = WorksheetFunction.RandBetween(8, 976)が更新されているのを目視出来ます。

お礼日時：2022/03/03 06:43

No.2 回答者： Qchan1962 回答日時： 2022/03/03 02:46

＃１です

＃１の回答はご質問に対して頓珍漢なものでした。すみません

＞スペースキーのクリックでも、[ If ek = 32 Then Stop　　’　この位置でマクロの実行は止まらない]という位置で、きちんと、止まるようにしたいです。
ExcelでスペースキーとEnter（Return）キーの違いを考えてみました
Enterは確定キーなのでセルが移動する。
スペースキーはアクティブセルが入力モードになりスペースが入力される
入力モードの時VBAは実行されなかったかと・・

では、キーを無効にしたらVBAの実行は無効にならず進むのでは無いかと思います。
キーを無効にする方法は色々ありますが
こんな感じで試してみてください。

Declare PtrSafe Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Sub Macro1()
Dim r, n, m, p As Integer, s As Integer, ti, ti1, ti2, ti3, ti4, i, k(150) As Integer
Application.Interactive = False
Application.EnableCancelKey = xlDisabled
r = 0: m = 0: ek = 0:
p = Cells(1, 10): s = Cells(2, 10) ' pは 1回の角度　sはsleepミリセコンド
ti = miri秒(): Cells(1, 1) = kk5: Cells(7, 1) = kk4
For i = 0 To 150: k(i) = p: Next: i = 5
Do While m < 360
ti1 = miri秒()
m = m + 1: Cells(9, 6) = Int(m * p / 360)
ActiveSheet.Shapes.Range(Array("Group 8")).IncrementRotation k(i)
Cells(3, 15) = (Cells(3, 15) + k(i)) Mod 360
Cells(3, 1) = kk5: Cells(8, 1) = kk4
ek = Eky(): Cells(3, 10) = ek: DoEvents: Sleep s:
If ek = 32 Then Stop '　この位置でマクロの実行は止まらない
If Cells(3, 10) > 0 Then m = 9000:
Loop
Stop '　この位置でもマクロの実行は止まらない
Application.Interactive = True
Application.EnableCancelKey = xlInterrupt
End Sub

Function Eky() As Single
Const tky = -32768 ' スペース32　エンター13で戻す
Eky = 0
If (GetAsyncKeyState(13) And tky) = tky Then
Eky = 13
ElseIf (GetAsyncKeyState(32) And tky) = tky Then
Eky = 32
End If
End Function

Function miri秒()
Call GetLocalTime(T)
' 現在日時取得Tを　 時刻以下ミリ秒までの数値にし,関数戻り値にする
' 注意　測定日を跨いでも忖度されない。年月日データを無視
kk1 = T.wHour: kk2 = T.wMinute: kk3 = T.wSecond: kk4 = T.wMilliseconds
kk4 = kk3 + kk4 / 1000
kk = kk1 * 3600 + kk2 * 60 + kk4: kk5 = kk1 & ":" & kk2 & ":" & kk3
miri秒 = kk
End Function

途中で止めた時に最後までF8などで実行しないと
Application.Interactive = True
Application.EnableCancelKey = xlInterrupt
が実行されないと思いますので、その場合は
イミディエイトウィンドウで実行するか
実行のタイミングを検討してください
Do While m < 360　は実行時間が短くないかな

コピペで書きましたがコンパイル出来なかったら修正してください
また頓珍漢な回答でしたら、忘れてください。

本日は夜遅くまでこちらを見れませんので　補足などがあっても
返信は遅くなります

この回答へのお礼

うーん
｢キーを無効に｣はしたくないです。

＞ Do While m < 360　は実行時間が短くないかな

Do While m < 3600　でも構いませんが、とりあえず360回転（約6分）で仮実験を止めているだけです。
　　～～～～～～～～～～～～～～～～～～～～～～～～
元の質問文の下の部分が、表現不適切でした。

｢スペース｣を押したときには期待通りの動作をしたりするときもあるのですが、Stopで止まらず、《単にマクロが終了し》、マクロ実行直前に選択していたExcelシートのセルに｢スペースが入力された途中の状態｣で終わるのです。

正しくは、
①　Sub Macro1()を直接に起動すると、期待通りの動作をします。
② Excelシート上の｢スタート｣ボタンで、Sub Macro1()を起動すると、スペースキーを押したときの動作がおかしい。Stopで止まらず、《単にマクロが終了し》、マクロ実行直前に選択していたExcelシートのセルに｢スペースが入力された途中の状態｣で終わるのです。

お礼日時：2022/03/03 09:43