VBAでMsgBoxを自作するメリットと作り方

VBAを使ったことがある人ならきっと誰でも使ったことがあるMsgBox関数。
その名の通りメッセージボックスを表示するための関数ですが、これを自作しました。
たった1行の処理を自作すると丸1日かかるんですね…という泣き言はともかく、あれこれ困った話。

メリット

Timerさんと喧嘩するから

Timerで登録した時間に~~する、という処理を実装したんですが、このTimerさんは標準ダイアログ(MsgBoxや印刷プレビュー、ページ設定など)を開いていると指定の時間になっても起爆しないという仕様みたいです。
もちろん指定の時間から数分経過してからでも、ダイアログを閉じればその時点で起爆します。
けど、それはもう指定の時間じゃないのです。
ですが、開発していたソフトはMsgBoxをいたるところで表示するソフトだったんです。
そしてFormは開いていてもダイアログとは違って、ちゃんと起爆することを発見し、幸いMsgBox関数を呼び出す処理自体は一箇所に集約されていたので、そうなると自作するしかないじゃないですか。

フォントや色のカスタマイズができる

最近の標準MsgBoxってフォントが小さくありませんか?
PCの解像度がどんどん高くなっているので仕方ないんですが、それでディスプレイ設定で「テキスト、アプリ、その他の項目のサイズを変更する」で100%より大きい値が指定されていたりして、それだと環境によってレイアウトが崩れたりするんですよね。

ボタンもカスタマイズできる

標準のボタンの種類ってちょっと使いにくくないですか?
3択にしたいけどvbYesNoCancelではないんだよな、とか。
自作すれば1~3までの数字選択ダイアログにもできます。

消音できる

自作するとメッセージボックスが出るときの警告音なども鳴るように処理を実装しますが、逆に言えば消音もできるってことです。
こういうときの警告は鳴らしたいけど、こっちの警告音は鳴らしたくないなんてことができるようになります。

アイコンを追加できる

そう、自作するとメッセージボックスのアイコンも用意しなければいけません。
逆に言えば、自由にアイコンも変えられるということ!

というわけで自作しましょう

まずはアイコンの用意

次にFormの用意

位置や文言は計算して配置するので、最初はこんな感じで良いと思います。

呼び出し関数の実装

今までと同じように使えるようにするとこんな感じ。

Public Function MsgBox(prompt As String, Optional buttons As VbMsgBoxStyle = vbOKOnly, Optional title As String = "") As VbMsgBoxResult

でも、色々とカスタマイズできるようにするとこんな感じ。

Public Function MsgBox(prompt As String, Optional buttons As VbMsgBoxStyle = vbOKOnly, _
                        Optional title As String = "", _
                        Optional FontColor As Long = vbBlack, _
                        Optional BackColor As Long = vbWhite, _
                        Optional bBeepOFF As Boolean = False, _
                        Optional bIconNotDisp As Boolean = False) As MsgBoxResult

処理としては、prompt とbuttonsを判別してFormのサイズを計算したり、ボタンの数・文言・表示座標・デフォルトフォーカスボタンを設定したり、アイコンの表示有無を判別して必要ならLoadPictures、アイコンの有無や大きさから文字列の表示座標を計算します。
文字列の折り返しですが、これで400を越えずにかつ適当なところで折り返してくれます。

With m_MessageLabel
    .AutoSize = False
    .Width = 400
    .Caption = prompt
    Call Me.Repaint
    .AutoSize = True
    Call Me.Repaint
End With

ビープ音を鳴らす

#If Win64 Then
    Private Declare PtrSafe Sub MessageBeep Lib "User32" (ByVal uType As Long)
#Else
    Private Declare Sub MessageBeep Lib "User32" (ByVal uType As Long)
#End If

Private Sub PlayBeep(buttons As VbMsgBoxStyle)
    Dim lngIconType As Long: lngIconType = buttons And &HF0
    If lngIconType = vbCritical Then
        MessageBeep (&H10)
    ElseIf lngIconType = vbExclamation Then
        MessageBeep (&H30)
    ElseIf lngIconType = vbInformation Then
        MessageBeep (&H40)
    End If
End Sub

表示位置を調整

表示&戻り値の返却

全部処理が終わって表示準備ができたら

Me.Show
MsgBox = m_Return

で表示&戻り値を返しましょう。

戻り値はVbMsgBoxResult型のメンバ変数を用意して、各ボタンのクリックイベントハンドラでボタンに応じた戻り値を設定しておきます。
また、UserForm_QueryCloseの実装も忘れずに。

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    ' Unloadで閉じる場合以外([X]ボタン押下、Windows終了、タスクマネージャーからKill)は戻り値はvbNo
    If CloseMode <> 1 Then
        m_Return = vbNo
    End If
End Sub

他にもニッチなIT関連要素をまとめていますので、よければ一覧記事もご覧ください。

1件のコメント

返信を残す

メールアドレスが公開されることはありません。

日本語が含まれない投稿は無視されますのでご注意ください。(スパム対策)