カウントダウン機能をメッセージボックスで表示させようとして、無理くり力技でコードを組んでみたのでござる ー MessageBoxTimeoutA（VBAマクロ）

       

VBAで、”もぐらたたき”ゲームのプログラムを、試行錯誤して書き上げました。

まあ、ネットで検索してもらえれば、サンプルコードは色々紹介されています。

なので、そういったコードを参照して試してもらえれば、楽しめるでしょうな。

一方、自分的には、ビジュアルな背景やアイコンを用意して臨場感を増したい。

サンプルコードの中には、セルに黒丸の印が出現し、それをクリックして消す。

実にシンプルなデザインでしたが、基本的なロジックはさほど変化ありません。

なので、ゲームらしくするには、デザインと意匠に趣向を凝らす必要があるな。

黒丸の代わりにモグラを画像を出現させて、クリックでドクロに置き換えたい。

後は、モグラのアイコンが出現したら、何か音を出すような工夫も必要だろう。

こうして、一定数のモグラを出したら終了させて、ヒット数を表示させるんだ。

そしてファンファーレなんかも再生させたら、少しは本格的なゲームに近づく。

そこで、今回は、スタートボタンを押したときのカウントダウンタイマーです。

幾つかアイデアを試しましたが、カウントダウンのメッセージにはこれだろう。

それは、メッセージボックスを一秒おきに表示しては消していくアイデアです。

Private Declare PtrSafe Function CustomTimeOffMsgBox Lib "user32" _Alias "MessageBoxTimeoutA" ( _

            ByVal xHwnd As LongPtr, _

            ByVal xText As String, _

            ByVal xCaption As String, _

            ByVal xMsgBoxStyle As VbMsgBoxStyle, _

            ByVal xwlange As Long, _

            ByVal xTimeOut As Long) _

    As Long

Sub TMP()

   Call CustomTimeOffMsgBox(0, "３秒後にスタートだよ", _

     "Kutools for Excel", vbInformation, 0, 1000)

   Call CustomTimeOffMsgBox(0, "２秒後にスタートだよ", _

     "Kutools for Excel", vbInformation, 0, 1000)

   Call CustomTimeOffMsgBox(0, "１秒後にスタートだよ", _

     "Kutools for Excel", vbInformation, 0, 1000)

*記述：(0, mMessage, "メッセージ内容", vbInformation, 0, milliSecond)

End Sub

         

このメッセージボックスは、Windowsの内臓機能にアクセスする設定をします。

”Windows API”という包括的な名称で呼んでいますが、VBAでも重宝しますな。

なので、実行プロシージャでは、モジュールの冒頭で宣言する記述を行います。

後は、一秒おきにメッセージボックスを表示させますが、警告音も出て便利だ。

というわけで、他に試したのがしょぼくて、こちらが簡単なので使用しました。

なぜ、しょぼかったかというと、一秒の間隔が実際には一秒以上あって、多少間延びするのでボツにしたのですが、わざわざユーザーフォームまで作ってタイマーをする必要もないなと、思ったのでした。

※採用見送りコード

Sub Sample()

  Dim WSH As Object, i As Integer

    Set WSH = CreateObject("WScript.Shell")

      For i = 3 To 1 Step -1　　

        WSH.Popup i & "秒後、スタートだよ", 1, "Title", vbInformation

      Next i

    Set WSH = Nothing

End Sub

いいねと思ったら、三つポチっとね！
  
にほんブログ村    にほんブログ村      にほんブログ村