تغيير اسماء ازرار ال msgbox

[أبو يحيى الجبلاوي]

السلام عليكم ورحمة الله وبركاته 

الله يعطيكم العافية عندي سؤال لو سمحتوا  

هل يمكنني تغيير اسم ازرار ال msgbox يعني على سبيل المثال 

MsgBox " هل تريد اعادة التعيين ", vbYesNo

هذه الرسالة تظهر على الشكل التالي كما تعلون 

 

 

اريد تغيير اسماء الازرار بحيث يكون بدل كلمة نعم --- اعادة التعيين  -     وبدل كلمة لا -- إالغاء الأمر  او اي اسم آخر اختاره انا وشكرا لكم 

 

[خالد المصـــــــــــرى]

ممكن ارفق الملف

[أبو يحيى الجبلاوي]

هو ملف مثال فقط ولكن على كل حال تفضل

تجربة 1.xlsm

[hegazee]

أخي الكريم أبو يحيى

ستحتاج إلى استخدام نموذج مخصص

(UserForm)

لأن وظيفة

MsgBox

المضمنة في

VBA

لا تدعم تغيير نص الأزرار و جرب هذا الملف

تجربة 2.xlsm

[أبو يحيى الجبلاوي]

نعم  اخي قمت باتخاذ هذا الاجراء شكرا لجهودك 

[أ / محمد صالح]

بارك الله فيكم جميعا

لتغيير نص أزرار رسالة msgbox يمكن استعمال هذا الموديول

يوجد مثالين للاستخدام

#If VBA7 Then
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" _
        () As Long
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
        (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    Private Declare PtrSafe Function CallNextHookEx Lib "user32" _
        (ByVal hHook As LongPtr, ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As LongPtr) As Long
    Private hHook As LongPtr        ' handle to the Hook procedure (global variable)
#Else
    Private Declare Function GetCurrentThreadId Lib "kernel32" _
        () As Long
    Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
        (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" _
        (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    Private Declare Function CallNextHookEx Lib "user32" _
        (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
    Private Declare Function UnhookWindowsHookEx Lib "user32" _
        (ByVal hHook As Long) As Long
    Private hHook As Long           ' handle to the Hook procedure (global variable)
#End If

Private Const WH_CBT = 5            ' hook type
Private Const HCBT_ACTIVATE = 5     ' activate window
Private sMsgBoxDefaultLabel(1 To 7) As String
Private sMsgBoxCustomLabel(1 To 7) As String
Private bMsgBoxCustomInit As Boolean

Private Sub MsgBoxCustom_Init()
    Dim nID As Integer
    Dim vA As Variant               ' base 0 array populated by Array function (must be Variant)
    vA = VBA.Array(vbNullString, "OK", "Cancel", "Abort", "Retry", "Ignore", "Yes", "No")
    For nID = 1 To 7
        sMsgBoxDefaultLabel(nID) = vA(nID)
        sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID)
    Next nID
    bMsgBoxCustomInit = True
End Sub

Public Sub MsgBoxCustom_Set(ByVal nID As Integer, Optional ByVal vLabel As Variant)
    If nID = 0 Then Call MsgBoxCustom_Init
    If nID < 1 Or nID > 7 Then Exit Sub
    If Not bMsgBoxCustomInit Then Call MsgBoxCustom_Init
    If IsMissing(vLabel) Then
        sMsgBoxCustomLabel(nID) = sMsgBoxDefaultLabel(nID)
    Else
        sMsgBoxCustomLabel(nID) = CStr(vLabel)
    End If
End Sub

Public Sub MsgBoxCustom_Reset(ByVal nID As Integer)
    Call MsgBoxCustom_Set(nID)
End Sub

#If VBA7 Then
    Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
#Else
    Private Function MsgBoxCustom_Proc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
#End If
    Dim nID As Integer
    If lMsg = HCBT_ACTIVATE And bMsgBoxCustomInit Then
        For nID = 1 To 7
            SetDlgItemText wParam, nID, sMsgBoxCustomLabel(nID)
        Next nID
    End If
    MsgBoxCustom_Proc = CallNextHookEx(hHook, lMsg, wParam, lParam)
End Function

Public Sub MsgBoxCustom( _
    ByRef vID As Variant, _
    ByVal sPrompt As String, _
    Optional ByVal vButtons As Variant = 0, _
    Optional ByVal vTitle As Variant, _
    Optional ByVal vHelpfile As Variant, _
    Optional ByVal vContext As Variant = 0)
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxCustom_Proc, 0, GetCurrentThreadId)
    If IsMissing(vHelpfile) And IsMissing(vTitle) Then
        vID = MsgBox(sPrompt, vButtons)
    ElseIf IsMissing(vHelpfile) Then
        vID = MsgBox(sPrompt, vButtons, vTitle)
    ElseIf IsMissing(vTitle) Then
        vID = MsgBox(sPrompt, vButtons, , vHelpfile, vContext)
    Else
        vID = MsgBox(sPrompt, vButtons, vTitle, vHelpfile, vContext)
    End If
    If hHook <> 0 Then UnhookWindowsHookEx hHook
End Sub

Sub Custom_MsgBox_1()
    MsgBoxCustom_Set vbOK, "Open"
    MsgBoxCustom_Set vbCancel, "Close"
    MsgBoxCustom ans, "Click a button.", vbOKCancel
End Sub
Sub Custom_MsgBox_2()
    MsgBoxCustom_Set vbYes, "Start"
    MsgBoxCustom_Set vbNo, "Stop"
    MsgBoxCustom ans, "Click a button.", (vbYesNo + vbQuestion)
End Sub

بالتوفيق للجميع