ただのメッセージボックスでは、人が操作しないと次の工程に進まなくなります。
VBAを使って、MSGBOXを自動的にOKを押して閉じるようにしたかったり、WSHでpopupを使ってみたが閉じなかった。不安定。なんて人は、この記事を見て、解決に向かうかもしれない。
メッセージボックス処理をさらに上に上げるために備忘録として記録する。
自動的に閉じるメッセージボックスで一番おすすめのコードは？
一番良いコードというのは定義が難しいですが、今回の一番良いコードの定義は正確性とします。
メッセージボックスが自動的に閉じるコードは何種類あるの？
僕が使ったことのあるコードでは、2種類です。
1つはWSHのコードで参照設定が必要になります。
もう一つが今回のおすすめコードであるMessageBoxTimeoutAのコードです。参照設定は必要ありませんが、宣言エリアに別コードを書かなくてはいけません。Sleep関数と同じようなイメージです。
MessageBoxTimeoutAコードの紹介
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 |
Private Declare Function MessageBoxTimeoutA Lib "user32" ( _ ByVal hWnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal uType As Long, _ ByVal wLanguageId As Long, _ ByVal dwMilliseconds As Long) As Long Private Function TimeoutA自動で閉じるメッセージボックス(待ち時間 As Long) As Long Dim AnswerVal As Long Dim MsgStr As String MsgStr = 待ち時間 & "秒後（" & TimeSerial(0, 0, 待ち時間) + time & _ "）に自動的に閉じて処理を開始します。" & Chr(10) & "動作の停止を希望の場合は、" & _ Chr(10) & "OKかキャンセルを押すもしくは、×閉じをしてください。" AnswerVal = MessageBoxTimeoutA(0&, MsgStr, "次の準備をしています", vbOKCancel, 0, 待ち時間 * 1000) TimeoutA自動で閉じるメッセージボックス = AnswerVal End Function |
MessageBoxTimeoutA返り値（戻り値）の紹介
| コード | 返り値（戻り値） |
|---|---|
| 自動で閉じる | 32000 |
| 自動で閉じる ※vbOKOnlyの時 |
1 |
| OK | 1 |
| キャンセル | 2 |
| 中止 | 3 |
| 再試行 | 4 |
| 無視 | 5 |
| Yes | 6 |
| No | 7 |
| ×ボタンで閉じる | 1 |
実際にどちら（TimeoutAかWSH）が優秀か検証してみた
実際に、僕がどんな検証をしてみたのか。その中から見えてきた問題点をもう一度。
動画で示す
動画の解説
自動で閉じる2種類のメッセージボックスのコードをファンクションで用意します。
そして、そのファンクションを使ってどちらの方が正確性が高いのかを検証しました。
WSHは、一度も自動で閉じることができませんでした。ここまで調子が悪いのは珍しいです。
実際には、時間より少し遅れた程度で自動的に閉じます。不安定であるというのが通常です。
ただし、TimeoutAの方が正確であるというのは変わらずです。
使用コード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 |
Private Declare Function MessageBoxTimeoutA Lib "user32" ( _ ByVal hWnd As Long, _ ByVal lpText As String, _ ByVal lpCaption As String, _ ByVal uType As Long, _ ByVal wLanguageId As Long, _ ByVal dwMilliseconds As Long) As Long Public Sub メッセージを起動させるループ() Dim LoopRun As Integer Dim AnsVal As Long Dim impTime As Date For LoopRun = 1 To 3 impTime = time AnsVal = TimeoutA自動で閉じるメッセージボックス(5) Debug.Print "==TimeoutA=====" & Chr(10) & "経過時間:" & DateDiff("s", impTime, time) impTime = time AnsVal = WSH自動で閉じるメッセージボックス(5) Debug.Print "==WSH=====" & Chr(10) & "経過時間:" & DateDiff("s", impTime, time) Next LoopRun End Sub '================================================================= ' 目的：メッセージボックスを表示させて、自分で閉じることができる。 ' 注意： '返り値の参考 '自動で閉じる：32000 （vbOkOnlyは、1として反映される） ' VbOK：1 OK ' VbCancel：2 キャンセル ' vbAbort：3 中止 ' vbRetry：4 再試行 ' vbIgnore：5 無視 ' VbYes：6 Yes ' VbNo：7 No ' ×閉じ：1 ボックスの右上にあるバッテンボタンを押す '----------------------------------------------------------------> '▼参照設定▼ ' '----------------------------------------------------------------> '▼動作▼ '取得した秒数分待つ '----------------------------------------------------------------> '▼更新履歴▼ ' '================================================================= Private Function TimeoutA自動で閉じるメッセージボックス(待ち時間 As Long) As Long Dim AnswerVal As Long Dim MsgStr As String MsgStr = 待ち時間 & "秒後（" & TimeSerial(0, 0, 待ち時間) + time & _ "）に自動的に閉じて処理を開始します。" & Chr(10) & "動作の停止を希望の場合は、" & _ Chr(10) & "OKかキャンセルを押すもしくは、×閉じをしてください。" AnswerVal = MessageBoxTimeoutA(0&, MsgStr, "次の準備をしています", vbOKCancel, 0, 待ち時間 * 1000) TimeoutA自動で閉じるメッセージボックス = AnswerVal End Function '================================================================= ' 目的：メッセージボックスを表示させて、自分で閉じることができる。 ' 注意： '返り値の参考 '自動で閉じる：-1 ' VbOK：1 OK ' VbCancel：2 キャンセル ' vbAbort：3 中止 ' vbRetry：4 再試行 ' vbIgnore：5 無視 ' VbYes：6 Yes ' VbNo：7 No '----------------------------------------------------------------> '▼参照設定▼ ' '----------------------------------------------------------------> '▼動作▼ '取得した秒数分待つ '----------------------------------------------------------------> '▼更新履歴▼ ' '================================================================= Public Function WSH自動で閉じるメッセージボックス(待ち時間 As Long) As Long Dim WSH As Object Dim MsgStr As String Dim AnswerVal As Long Set WSH = CreateObject("WScript.Shell") MsgStr = 待ち時間 & "秒後（" & TimeSerial(0, 0, 待ち時間) + time & _ "）に自動的に閉じて処理を開始します。" & _ Chr(10) & "動作の停止を希望の場合は、OKボタンを押してください。" AnswerVal = WSH.Popup(MsgStr, 待ち時間, "操作可能時間", vbOKOnly) Set WSH = Nothing WSH自動で閉じるメッセージボックス = AnswerVal End Function |
VBA初心者です。WSHの勉強中にここに辿り着きました。
MessageBoxTimeoutAコードの紹介を見て、標準モジュールにコピペしても
コンパイルエラーになってしまいます。(´；ω；`)ｳｩｩ
こんばんは、返信がかなり遅れて申し訳ありません。。。コメントがめったに付かないものでして、、、
貴重なコメントありがとうございます。
エラーコードは何になっておりますでしょうか？僕がチェックした限り2つのエラーが想定されています。
①Declare後に追記が必要な場合がある
今、2台のPCで試したのですが、Surfaceですと動くようです。。。
Lenovoは動きませんでした。Lenovoでの改善方法は、1行目を下記のように書き換えました。
Private Declare PtrSafe Function(
上記のように「PtrSafe」を追記してチャレンジしてみてください。
②「&」が「& amp;」に変換されている（都合上、&とamp;の間に空白を入れております。）
もう一つ考えられるエラーは、僕の知識不足なんですが、「&」が「& amp;」に書き換わっていることです。
これは、htmlの部分になります。このエラーの場合は、メッセージボックスの部分でエラーが出ていると思います。
「&」のみにすると修正が可能です。お手数ですがよろしくお願いします。
コメント頂きましてありがとうございます。できなかった場合はまた、ご連絡ください。
タケイチ様
返信ありがとうございました。
随分前に、MessageBoxTimeoutAコードの紹介にて、コメントさせていただいた ” にゃん ” です。
思い出して…お礼を言わせて頂きに来ました。
ホントに
↓にあるとうりですね。
自動的にメッセージボックスを閉じるならWSHは使わない！messageboxtimeoutAを使う
私がしたのは、カウントダウンタイマーを走らせながらWSHを使用して MsgBox を5秒間表示させて
自動で閉じようと頑張っていたのですが、全く安定しないのでいろいろ探したらここにたどり着きました。
あの後少々四苦八苦したのですが、TimeoutA でやっと安定させた動作が得られました。
一部ですが下記の感じです。
Dim setTime As Date
Public Declare Function MessageBoxTimeoutA Lib “user32” _
(ByVal hWnd As Long, _
ByVal lpText As String, _
ByVal lpCaption As String, _
ByVal uType As Long, _
ByVal wLanguageId As Long, _
ByVal dwMilliseconds As Long) As Long
setTime = Now + TimeValue(“00:00:05”)
Application.OnTime setTime, “TimeoutA” ‘ Call 呼び出し
本当にこれで良いかVBA初心者の為わかりませんが
もう少し実装試験をいろいろしてみます。
本当にありがとうございました。