متد ShowMessageBox از VBAUtil برای نمایش MessageBox با امکاناتی مانند:
کلیدهای با متن فارسی
کلیدهای با متن سفارشی
کلیدهای با تصویر
انتخاب فونت و اندازه متن
تعیین راست به چپ بودن متن
تعیین نمایش آیکون و سدا
امکان تعریف تایمر برای یک کلید خاص
امکان نمایش یک چک باکس برای تعیین وضعیت نمایش پیام در دفعات بعد
Function ShowMessageBox(
Message As String,
Title As String,
Optional MessageBox_Style As MsgboxStyle = MsgboxStyle.Information,
Optional MessageBox_Type As MsgboxType = MsgboxType.OkOnly,
Optional Has_Image As Boolean = True,
Optional Has_Sound As Boolean = True,
Optional Right_To_Left As Boolean = True,
Optional Persian_Numbers As Boolean = True,
Optional Persian_Buttons As Boolean = True,
Optional Font_Name As Font_Name = Font_Name.Segoe_UI,
Optional Font_Size As Font_Size = Font_Size.Normal,
Optional Font_Bold As Boolean = False,
Optional Button_1_Text As String = "",
Optional Button_2_Text As String = "",
Optional Button_3_Text As String = "",
Optional TimeInterval As Integer = 0,
Optional TimedButton As Integer = 1,
Optional Show_SuppressNextTime As Boolean = False
) As MessageBoxResult
Class MessageBoxResult
' Properties
Result As Integer
VBA_ButtonName As String
DoNotShowAgain As Boolean
Enum MsgboxStyle As Integer
None = 0
Information = 1
Exclamation = 2
Critical = 3
Warning = 4
End Enum
Enum MsgboxType As Integer
OkOnly = 0
OkCancel = 1
YesNo = 2
RetryCancel = 3
AbortRetryIgnore = 4
YesNoCancel = 5
Custom_1_Button = 10
Custom_2_Buttons = 11
Custom_3_Buttons = 12
End Enum
Enum Font_Name As Integer
Segoe_UI = 2
Tahoma = 3
Arial = 4
Microsoft_Sans_Serif = 5
Times_New_Roman = 6
Courier_New = 7
Calibri = 8
End Enum
Enum Font_Size As Integer
Small = 1
Normal = 2
Medium = 3
Large = 4
End Enum
کد نمونه:
Option Compare Database
Option Explicit
Sub Example_1()
Dim title, message As String
title = "خطا در ارتباط با شبکه"
message = "ارتباط با سرور به آدرس 192.168.1.224 برقرار نشد." & vbCrLf & _
"برای ثبت تغییرات ارتباط با سرور الزامی است." & vbCrLf & vbCrLf & _
"دوباره سعی میکنید؟"
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
message:=message, _
title:=title, _
messagebox_style:=MsgboxStyle_Warning, _
messagebox_type:=MsgboxType_RetryCancel, _
has_image:=True, _
Has_Sound:=True, _
right_to_left:=True, _
Persian_Numbers:=False, _
Persian_Buttons:=True, _
Font_Name:=Font_Name_Times_New_Roman, _
Font_Size:=Font_Size_Large, _
Font_Bold:=False, _
TimeInterval:=60, _
TimedButton:=1, _
Show_SuppressNextTime:=True)
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
messagebox1.png
Sub Example_2()
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox(title:="", message:="ثبت سند با موفقیت انجام شد.")
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
messagebox4.png
Sub Example_3()
Dim title, message As String
title = "غزلیات حافظ - غزل شماره26"
message = _
"زلـفآشفته و خویکـرده و خندانلب و مست" & vbCrLf & _
"پیرهنچـاک و غزلخـوان و صُراحی در دسـت" & vbCrLf & _
"نرگـسـش عربـدهجوی و لبـش افـسوسکـنان" & vbCrLf & _
"نیم شب دوش بـه بـالین مـن آمـد بنشست" & vbCrLf & _
"سر فـرا گـوش مـن آورد بـه آواز حزیـن" & vbCrLf & _
"گفت ای عاشــق دیرینه مـن خوابت هـست؟" & vbCrLf & _
"عاشقی را کـه چنین بـاده شبگیـر دهـند" & vbCrLf & _
"کافـر عــشق بـود گـر نشود بـاده پرست" & vbCrLf & _
"برو ای زاهــد و بر دُردکشان خرده مگیر" & vbCrLf & _
"که ندادند جز این تحفه به ما روز الست" & vbCrLf & _
"آن چه او ریخت به پیمانـه ما نـوشیدیم" & vbCrLf & _
"اگـر از خَـمر بـهشت است وگر باده مـست" & vbCrLf & _
"خـنده جـامِ مـی و زلـفِ گـرهگـیر نگـار" & vbCrLf & _
"ای بسا توبه که چـون توبه حـافـظ بشکست"
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
title:=title, _
message:=message, _
Persian_Buttons:=True, _
Has_Sound:=False, _
has_image:=False, _
Font_Name:=Font_Name_Courier_New, _
Font_Bold:=True, _
Font_Size:=Font_Size_Large, _
messagebox_type:=MsgboxType_Custom_1_Button, _
messagebox_style:=MsgboxStyle_None, _
button_1_text:="خواندم!" _
)
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
messagebox3.jpg
Sub Example_5()
Dim title, message As String
title = "انتخاب خروجی"
message = "گزارش سالانه آماده شد."
Dim r As New MessageBoxResult
Set r = v.ShowMessageBox( _
title:=title, _
message:=message, _
messagebox_style:=MsgboxStyle_Exclamation, _
messagebox_type:=MsgboxType_Custom_3_Buttons, _
has_image:=False, _
button_1_text:="چاپ", _
button_2_text:="فایل pdf", _
button_3_text:="ارسال به email")
Debug.Print r.VBA_ButtonName, r.DoNotShowAgain, r.Result
End Sub
messagebox2.png