ライブラリ

Msg_Show

******************************************************************************************************************************
メッセージボックスのラッパー

【重要】既存のMsgBoxは引数を[+]して指定するが、
            この関数ではコーディングしやすいよう、
            引数を分類分けしている。
            ※1モジュール(例:M_MsgBox)に下記のコードのみを記述する事を推奨
            ※既存の列挙体(VbMsgBoxStyle等)を、自作列挙体(E_MsgBox_Button)に
               同名のメンバーを作って値をそのままあてることで、
               既存のMsgBoxに影響を与えることなく、違和感が少なく使えるようにしている。

【引数】Message:メッセージ本文
            Icon:vbCritical等のアイコンを指定
            Button:vbOKOnly等を指定
            Default:デフォルトでアクティブになっているボタンを指定
            Title:メッセージのタイトルを指定(ConstのMsg_Titleでデフォルトを調整)

【戻値】vbOK等(必要に応じてEnum の E_MsgBox_Result メンバーを調整)
******************************************************************************************************************************
2021/10/22 改行コードの調整処理を追加

Option Explicit
Option Private Module

Public Const Msg_Title              As String = "System"

Public Enum E_MsgBox_Icon
    vbCritical = VbMsgBoxStyle.vbCritical
    vbExclamation = VbMsgBoxStyle.vbExclamation
    vbInformation = VbMsgBoxStyle.vbInformation
    vbQuestion = VbMsgBoxStyle.vbQuestion
End Enum

Public Enum E_MsgBox_Button
    vbOKOnly = VbMsgBoxStyle.vbOKOnly
    vbOKCancel = VbMsgBoxStyle.vbOKCancel
'    vbYesNoCancel = VbMsgBoxStyle.vbYesNoCancel    '出番が無いのでコメントアウト
'    vbYesNo = VbMsgBoxStyle.vbYesNo                '出番が無いのでコメントアウト
End Enum

Public Enum E_MsgBox_Result
    vbOK = VbMsgBoxResult.vbOK
'    vbCancel = VbMsgBoxResult.vbCancel             '出番が無いのでコメントアウト
'    vbYes = VbMsgBoxResult.vbYes                   '出番が無いのでコメントアウト
'    vbNo = VbMsgBoxResult.vbNos                    '出番が無いのでコメントアウト
End Enum

Public Enum E_MsgBox_Default
    vbButton1 = VbMsgBoxStyle.vbDefaultButton1
    vbButton2 = VbMsgBoxStyle.vbDefaultButton2
'    vbButton3 = VbMsgBoxStyle.vbDefaultButton3     '出番が無いのでコメントアウト
'    vbButton4 = VbMsgBoxStyle.vbDefaultButton4     '出番が無いのでコメントアウト
End Enum

Public Function Msg_Show(Message As String, _
                         Optional Icon As E_MsgBox_Icon = E_MsgBox_Icon.vbCritical, _
                         Optional Button As E_MsgBox_Button = E_MsgBox_Button.vbOKOnly, _
                         Optional Default As E_MsgBox_Default = E_MsgBox_Default.vbButton1, _
                         Optional Title As String = Msg_Title) As E_MsgBox_Result
    
    '今の画面停止設定を取得
    Dim ScreenUpdate    As Boolean
    ScreenUpdate = Application.ScreenUpdating
    
    '画面停止のスイッチ
    If ScreenUpdate = False Then Application.ScreenUpdating = True
    
    'クエスチョンがある場合、自動的に質問アイコンに変更
    Dim Icn As E_MsgBox_Icon
    Icn = Icon
    If InStr(1, Message, "?", vbTextCompare) <> 0 Then
        Icn = vbQuestion
    End If
    
    '質問時、ボタンをOKキャンセルに自動変更
    Dim Btn As E_MsgBox_Button
    Btn = Button
    If Icn = vbQuestion Then
        Btn = vbOKCancel
    End If
    
    'メッセージをコピペした時の為に、改行[CrLf]を[Lf]に変換(CrよりLfの方が自然なので)
    Dim Prompt  As String
    Prompt = Replace(Message, vbCrLf, vbLf)
    
    'メッセージ表示
    Msg_Show = MsgBox(Prompt, Icn + Btn + Default + vbSystemModal, Title)
    
    '画面停止のスイッチ
    If ScreenUpdate = False Then Application.ScreenUpdating = False
    
End Function

MsgBox   2017/07/11   shono

この記事へのコメント

コメントを送る

 
※ メールは公開されません
Loading...
 画像の文字を入力してください