******************************************************************************************************************************
メッセージボックスのラッパー
【重要】既存の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