おーぷんにしたいこと

ツイッターの鍵の向こうに置いておきたいものを書きます

VBAのMsgBox(メッセージボックス)を作成するためのフォームを作ったよ

【スポンサーリンク】


ちょっとしたマクロを作る時も、しっかりめのデータベースを作る時も、何かと使うMsgBox。
でも、きちんと作ろうと思ったら何かと面倒なMsgBox。
簡単に作れてプレビューもできるものがあれば……と思い立って作成してみたら、意外と使えるものができました。
ファイルをダウンロードできない環境の方もいると思うのでフォームデザインとコードを公開します。
ちょっとだけコントロールの設定変更が必要ですが、コードはコピペで大丈夫です。

サンプル

こういうのが作れます。

f:id:teali_s:20210118220446p:plain:w500
↑入力・選択して[コード生成&サンプル表示]をクリック

f:id:teali_s:20210118220320p:plain:w500

  • タイトルと内容を入力通りに生成(改行もEnterのみで出来ます)

  • ボタンまわりの設定をプルダウンで選択できる(既定値は選択しなくてもOK)

  • 入力・選択した内容でサンプル表示

  • コード生成(If文用も作れます)

フォームの準備

各コントロールの名前はこんな感じです。
f:id:teali_s:20210118225105p:plain:w600

コンボボックスを4つ設置して名前を変更

CoB_btnStyle1
CoB_btnStyle2
CoB_IconStyle
CoB_ModalStyle

コンボボックスの設定を以下のように変更
【Access】
列数:2
列幅:;0cm
値集合タイプ:値リスト
連結列:1

【Excel】
ColumnCount:2
ColumnWidths:;0pt

コマンドボタンを2つ設置して名前を変更

CmB_Cre
CmB_Reset

コマンドボタンのラベルを変更
※処理には関係ないので文面は違ってもOK。
CmB_Cre:コード生成&サンプル表示
CmB_Reset:リセット

チェックボックスを5つ設置して名前を変更

ChB_Help
ChB_Right
ChB_Fore
ChB_Rtl
ChB_If

チェックボックスのラベルを変更
※処理には関係ないので文面は違ってもOK。
ChB_Help:ヘルプボタン表示
ChB_Right:テキスト右揃え
ChB_Fore:前景ウィンドウ指定
ChB_Rtl:右→左読み言語用
ChB_If:IF文に使う

テキストボックスを3つ設置して名前を変更

TeB_Title
TeB_Prompt
TeB_MsgCode

TeB_Promptの設定を変更
【Access】
Enterキー入力時動作:フィールドに行を追加

【Excel】
EnterKeyBehavior :True
MultiLine:True

TeB_MsgCodeの設定を変更(Excelのみ
【Excel】
MultiLine:True

コードをコピペ

AccessとExcelではコードが結構変わってくるため、別々に用意しました。
ちなみにCmB_Resetだけ同じです。

Accessのコード

Private Sub Form_Open(Cancel As Integer)
    'コンボボックスの値集合ソースを指定
    Me.CoB_btnStyle1.RowSource = "vbOKOnly(既定値);0;vbOKCancel;1;vbAbortRetryIgnore;2;vbYesNoCancel;3;vbYesNo;4;vbRetryCancel;5"
    Me.CoB_btnStyle2.RowSource = "vbDefaultButton1(既定値);0;vbDefaultButton2;256;vbDefaultButton3;512;vbDefaultButton4;768"
    Me.CoB_IconStyle.RowSource = "なし;0;vbCritical;16;vbQuestion;32;vbExclamation;48;vbInformation;64"
    Me.CoB_ModalStyle.RowSource = "vbApplicationModal(既定値);0;vbSystemModal;4096"
End Sub

Private Sub CmB_Cre_Click()
    Dim btn1I As Long, btn2I As Long, icnI As Long, mdlI As Long, hlpI As Long, forI As Long, rgtI As Long, rtlI As Long
    
    'ボタンの値を計算する
    btn1I = Nz(Me.CoB_btnStyle1.Column(1), 0)
    btn2I = Nz(Me.CoB_btnStyle2.Column(1), 0)
    icnI = Nz(Me.CoB_IconStyle.Column(1), 0)
    mdlI = Nz(Me.CoB_ModalStyle.Column(1), 0)
    hlpI = IIf(Me.ChB_Help = True, 16384, 0)
    forI = IIf(Me.ChB_Fore = True, 65536, 0)
    rgtI = IIf(Me.ChB_Right = True, 524288, 0)
    rtlI = IIf(Me.ChB_Rtl = True, 1048576, 0)
    
    '全て足す
    BtnInt = btn1I + btn2I + icnI + mdlI + hlpI + forI + rgtI + rtlI
    
    'ボタンの定数を変数に入れる
    btn1S = IIf(btn1I = 0, Null, Me.CoB_btnStyle1 & " + ")
    btn2S = IIf(btn2I = 0, Null, Me.CoB_btnStyle2 & " + ")
    icnS = IIf(icnI = 0, Null, Me.CoB_IconStyle & " + ")
    mdlS = IIf(mdlI = 0, Null, Me.CoB_ModalStyle & " + ")
    hlpS = IIf(hlpI = 0, Null, "vbMsgBoxHelpButton + ")
    forS = IIf(forI = 0, Null, "vbMsgBoxSetForeground + ")
    rgtS = IIf(rgtI = 0, Null, "vbMsgBoxRight + ")
    rtlS = IIf(rtlI = 0, Null, "vbMsgBoxRtlReading + ")
    
    '合体して末尾の+を消す
    BtnStr = btn1S & btn2S & icnS & mdlS & hlpS & forS & rgtS & rtlS
    If IsNull(BtnStr) = False Then BtnStr = IIf(Right(BtnStr, 3) = " + ", Left(BtnStr, Len(BtnStr) - 3), BtnStr)
    
    '本文の改行を文字列化
    prm = Replace(Nz(Me.TeB_Prompt, ""), vbCrLf, """ & vbCrLf & """) '『vbCrLf』→『" & vbCrLf & "』にするためChrは使えない
    prm = Replace(prm, """"" & ", "") '『""""" &』→『"" &』主に1行空白の改行用
    prm = Chr(34) & prm & Chr(34) 'ダブルクォーテーションで挟む(Chr(34) = ")
    
    'タイトルを変数に入れる
    TitStr = Me.TeB_Title 'ここで""するとTeB_TitleがNullでも『TitStr = """"』になるので後で付ける
    
    '本文以降(ボタンとタイトル)が既定値および空白の場合はカンマを除去
    If IsNull(BtnStr) = True And IsNull(TitStr) = True Then 'ボタンもタイトルもなし
        bt = ""
    ElseIf IsNull(BtnStr) = False And IsNull(TitStr) = True Then 'ボタンあり・タイトルなし
        bt = ", " & BtnStr
    ElseIf IsNull(BtnStr) = True And IsNull(TitStr) = False Then 'ボタンなし・タイトルあり
        bt = ", , " & Chr(34) & TitStr & Chr(34)
    Else '両方あり
        bt = ", " & BtnStr & ", " & Chr(34) & TitStr & Chr(34)
    End If
    
    'コード作成
    If Me.ChB_If = True Then 'If文
        Me.TeB_MsgCode = "If MsgBox(" & prm & bt & ") = Then"
    Else
        Me.TeB_MsgCode = "MsgBox " & prm & bt
    End If
    
    'サンプル表示(タイトルが空白の場合はアプリケーション名を入れる)
    MsgBox Nz(Me.TeB_Prompt, ""), BtnInt, IIf(IsNull(TitStr) = True, Application.Name, TitStr)
End Sub

Private Sub CmB_Reset_Click()
    Me.TeB_Title = Null
    Me.TeB_Prompt = Null
    Me.TeB_MsgCode = ""
    
    Me.CoB_btnStyle1 = Null
    Me.CoB_btnStyle2 = Null
    Me.CoB_IconStyle = Null
    Me.CoB_ModalStyle = Null
    Me.ChB_Help = False
    Me.ChB_Fore = False
    Me.ChB_Right = False
    Me.ChB_Rtl = False
End Sub


Excelのコード

コンボボックスの値の設定方法が違うのと、Nzが使えないのでIIfに置き換えています。

Private Sub UserForm_Initialize()
    'コンボボックスを設定(1列目にラベル、2列目に値)
    Arrbtn11 = Array("vbOKOnly(既定値)", "vbOKCancel", "vbAbortRetryIgnore", "vbYesNoCancel", "vbYesNo", "vbRetryCancel")
    Arrbtn12 = Array("0", "1", "2", "3", "4", "5")

    For lp = 0 To UBound(Arrbtn11)
        With CoB_btnStyle1
            .AddItem ""
            .List(lp, 0) = Arrbtn11(lp)
            .List(lp, 1) = Arrbtn12(lp)
        End With
    Next
    
    Arrbtn21 = Array("vbDefaultButton1(既定値)", "vbDefaultButton2", "vbDefaultButton3", "vbDefaultButton4")
    Arrbtn22 = Array("0", "256", "512", "768")

    For lp = 0 To UBound(Arrbtn21)
        With CoB_btnStyle2
            .AddItem ""
            .List(lp, 0) = Arrbtn21(lp)
            .List(lp, 1) = Arrbtn22(lp)
        End With
    Next
    
    Arrbtn31 = Array("なし", "vbCritical", "vbQuestion", "vbExclamation", "vbInformation")
    Arrbtn32 = Array("0", "16", "32", "48", "64")

    For lp = 0 To UBound(Arrbtn31)
        With CoB_IconStyle
            .AddItem ""
            .List(lp, 0) = Arrbtn31(lp)
            .List(lp, 1) = Arrbtn32(lp)
        End With
    Next
    
    Arrbtn41 = Array("vbApplicationModal(既定値)", "vbSystemModal")
    Arrbtn42 = Array("0", "4096")

    For lp = 0 To UBound(Arrbtn41)
        With CoB_ModalStyle
            .AddItem ""
            .List(lp, 0) = Arrbtn41(lp)
            .List(lp, 1) = Arrbtn42(lp)
        End With
    Next
End Sub

Private Sub CmB_Cre_Click()
    Dim btn1I As Long, btn2I As Long, icnI As Long, mdlI As Long, hlpI As Long, forI As Long, rgtI As Long, rtlI As Long
    
    'ボタンの値を計算する
    'コンボボックスが無選択の状態でIIf使うとエラーで判定できない
    If CoB_btnStyle1 = "" Then
        btn1I = 0
    Else
        btn1I = CoB_btnStyle1.Column(1)
    End If
    
    If CoB_btnStyle2 = "" Then
        btn2I = 0
    Else
        btn2I = CoB_btnStyle2.Column(1)
    End If
    
    If CoB_IconStyle = "" Then
        icnI = 0
    Else
        icnI = CoB_IconStyle.Column(1)
    End If
    
    If CoB_ModalStyle = "" Then
        mdlI = 0
    Else
        mdlI = CoB_ModalStyle.Column(1)
    End If
    
    hlpI = IIf(ChB_Help = True, 16384, 0)
    forI = IIf(ChB_Fore = True, 65536, 0)
    rgtI = IIf(ChB_Right = True, 524288, 0)
    rtlI = IIf(ChB_Rtl = True, 1048576, 0)
    
    '全て足す
    BtnInt = btn1I + btn2I + icnI + mdlI + hlpI + forI + rgtI + rtlI
    
    'ボタンの定数を変数に入れる
    btn1S = IIf(btn1I = 0, Null, CoB_btnStyle1 & " + ")
    btn2S = IIf(btn2I = 0, Null, CoB_btnStyle2 & " + ")
    icnS = IIf(icnI = 0, Null, CoB_IconStyle & " + ")
    mdlS = IIf(mdlI = 0, Null, CoB_ModalStyle & " + ")
    hlpS = IIf(hlpI = 0, Null, "vbMsgBoxHelpButton + ")
    forS = IIf(forI = 0, Null, "vbMsgBoxSetForeground + ")
    rgtS = IIf(rgtI = 0, Null, "vbMsgBoxRight + ")
    rtlS = IIf(rtlI = 0, Null, "vbMsgBoxRtlReading + ")
    
    '合体して末尾の+を消す
    BtnStr = btn1S & btn2S & icnS & mdlS & hlpS & forS & rgtS & rtlS
    If IsNull(BtnStr) = False Then BtnStr = IIf(Right(BtnStr, 3) = " + ", Left(BtnStr, Len(BtnStr) - 3), BtnStr)
    
    '本文の改行を文字列化
    prm = Replace(IIf(IsNull(TeB_Prompt), "", TeB_Prompt), vbCrLf, """ & vbCrLf & """) '『vbCrLf』→『" & vbCrLf & "』にするためChrは使えない
    prm = Replace(prm, """"" & ", "") '『""""" &』→『"" &』主に1行空白の改行用
    prm = Chr(34) & prm & Chr(34) 'ダブルクォーテーションで挟む(Chr(34) = ")
    
    'タイトルを変数に入れる
    TitStr = TeB_Title 'ここで""するとTeB_TitleがNullでも『TitStr = """"』になるので後で付ける
    
    '本文以降(ボタンとタイトル)が既定値および空白の場合はカンマを除去
    If IsNull(BtnStr) = True And IsNull(TitStr) = True Then 'ボタンもタイトルもなし
        bt = ""
    ElseIf IsNull(BtnStr) = False And IsNull(TitStr) = True Then 'ボタンあり・タイトルなし
        bt = ", " & BtnStr
    ElseIf IsNull(BtnStr) = True And IsNull(TitStr) = False Then 'ボタンなし・タイトルあり
        bt = ", , " & Chr(34) & TitStr & Chr(34)
    Else '両方あり
        bt = ", " & BtnStr & ", " & Chr(34) & TitStr & Chr(34)
    End If
    
    'コード作成
    If ChB_If = True Then 'If文
        TeB_MsgCode = "If MsgBox(" & prm & bt & ") = Then"
    Else
        TeB_MsgCode = "MsgBox " & prm & bt
    End If
    
    'サンプル表示(タイトルが空白の場合はアプリケーション名を入れる)
    MsgBox IIf(IsNull(TeB_Prompt), "", TeB_Prompt), BtnInt, IIf(IsNull(TitStr) = True, Application.Name, TitStr)
End Sub

Private Sub CmB_Reset_Click()
    TeB_Title = Null
    TeB_Prompt = Null
    TeB_MsgCode = ""
    
    CoB_btnStyle1 = Null
    CoB_btnStyle2 = Null
    CoB_IconStyle = Null
    CoB_ModalStyle = Null
    ChB_Help = False
    ChB_Fore = False
    ChB_Right = False
    ChB_Rtl = False
End Sub


おまけ(設定のメモ)

せっかく書いたので一応置いておきます。
参考: MsgBox 関数 (Visual Basic for Applications) | Microsoft Docs

'CoB_btnStyle1 ボタン表示
'vbOKOnly 0 [OK]
'vbOKCancel 1 [OK][キャンセル]
'vbAbortRetryIgnore 2 [中止][再試行][無視]
'vbYesNoCancel 3 [はい][いいえ][キャンセル]
'vbYesNo 4 [はい][いいえ]
'vbRetryCancel 5 [再試行][キャンセル]

'CoB_btnStyle2 既定のボタン
'vbDefaultButton1 0 1番目
'vbDefaultButton2 256 2番目
'vbDefaultButton3 512 3番目
'vbDefaultButton4 768 4番目

'CoB_IconStyle アイコン
'vbCritical 16 [重大なメッセージ]
'vbQuestion 32 [警告クエリ]
'vbExclamation 48 [警告メッセージ]
'vbInformation 64 [情報メッセージ]

'CoB_ModalStyle モーダル
'vbApplicationModal 0 アプリケーションモーダル(現在のアプリケーションが中断)
'vbSystemModal 4096 システムモーダル(全てのアプリケーションが中断)

'vbMsgBoxHelpButton 16384 [ヘルプ]追加
'vbMsgBoxSetForeground 65536 メッセージボックスを前景ウィンドウにする
'vbMsgBoxRight 524288 テキストを右揃えにする
'vbMsgBoxRtlReading 1048576 ヘブライ語,アラビア語のテキスト表示形式を指定(右から左に読む形式で表示)


【スポンサーリンク】