Tặng Hàm MsgBox Việt hóa bằng Unicode tuyệt đẹp!

[Hoàng Trọng Nghĩa]

Tặng Hàm MsgBox Việt hóa bằng Unicode tuyệt đẹp!

Với cải tiến lần này, MsgBox thân thiện hơn, đẹp hơn, nút lệnh theo Application nên mượt mà hơn.

Có thể chọn Nút lệnh mặc định để khi Enter là chạy thủ tục tại nút đó

Đặc biệt, một phát hiện mới là có thể tô đậm dòng tiêu đề bên trong nội dung MsgBox

Và hơn thế nữa, đó chính là có thể Việt hóa tên nút lệnh một cách dễ dàng theo ý muốn của chúng ta!



Hàm chuyển đổi nút lệnh:

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
                            
    If lMsg = HCBT_ACTIVATE Then
        [COLOR=#006400]'De biet Charcode, dung ham ASCW("KyTu")[/COLOR]
        StrOK = ChrW$(272) & ChrW$(7891) & "&ng " & ChrW$(253)     [COLOR=#006400] 'Dong y[/COLOR]
        StrCancel = "&H" & ChrW$(7911) & "y b" & ChrW$(7887)       [COLOR=#006400] 'Huy bo[/COLOR]
        StrAbort = "&H" & ChrW$(7911) & "y ngang"                  [COLOR=#006400] 'Huy ngang[/COLOR]
        StrRetry = "&Th" & ChrW$(7917) & " l" & ChrW$(7841) & "i"  [COLOR=#006400] 'Thu lai[/COLOR]
        StrIgnore = "&B" & ChrW$(7887) & " qua"                     [COLOR=#006400]'Bo qua[/COLOR]
        StrYes = "&Có"                                              [COLOR=#006400]'Co[/COLOR]
        StrNo = "&Không"                                           [COLOR=#006400] 'Khong[/COLOR]
        StrYesAll = "Có &t" & ChrW$(7845) & "t c" & ChrW$(7843)     [COLOR=#006400]'Co tat ca[/COLOR]
    
        SetDlgItemText wParam, IdOK, StrConv(StrOK, vbUnicode)
        SetDlgItemText wParam, IdCancel, StrConv(StrCancel, vbUnicode)
        SetDlgItemText wParam, IdAbort, StrConv(StrAbort, vbUnicode)
        SetDlgItemText wParam, IdRetry, StrConv(StrRetry, vbUnicode)
        SetDlgItemText wParam, IdIgnore, StrConv(StrIgnore, vbUnicode)
        SetDlgItemText wParam, IdYes, StrConv(StrYes, vbUnicode)
        SetDlgItemText wParam, IdNo, StrConv(StrNo, vbUnicode)
        SetDlgItemText wParam, IdYesAll, StrConv(StrYesAll, vbUnicode)
    
        UnhookWindowsHookEx hHook
    End If
    MsgBoxHookProc = False
End Function

Hàm MyUniMsgBox:

Function MyUniMsgBox(ByVal msgTitle As String, _
                     Optional msgText As String, _
                     Optional msgButtonType As MsoAlertButtonType, _
                     Optional msgIconType As MsoAlertIconType, _
                     Optional msgDefaultType As MsoAlertDefaultType) As VbMsgBoxResult
[COLOR=#006400]    'Cau truc:
    'MyUniMsgBox TieuDe (bat buoc), NoiDung (bat buoc), [KieuNutLenh], [KieuIcon], [KieuNutLenhMacDinh][/COLOR]
 
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
 
    On Error GoTo DefaultFirst
    MyUniMsgBox = Application.Assistant.DoAlert( _
                                        msgTitle, _
                                        msgText, _
                                        msgButtonType, _
                                        msgIconType, _
                                        msgDefaultType, _
                                        msoAlertCancelDefault, _
                                        False)
    Exit Function

DefaultFirst:
    On Error Resume Next
    MyUniMsgBox = Application.Assistant.DoAlert( _
                                        msgTitle, _
                                        msgText, _
                                        msgButtonType, _
                                        msgIconType, _
                                        msoAlertDefaultFirst, _
                                        msoAlertCancelDefault, _
                                        False)
End Function

Cách sử dụng:

        MyUniMsgBox TieuDe, NoiDung

        MyUniMsgBox TieuDe, NoiDung & .[B3], _
                            msoAlertButtonOK, _
                            msoAlertIconInfo, _
                            msoAlertDefaultFirst

        MyUniMsgBox TieuDe, NoiDung & .[B6], _
                            msoAlertButtonYesNoCancel, _
                            msoAlertIconQuery, _
                            msoAlertDefaultThird

        MyUniMsgBox TieuDe, NoiDung & .[B8], _
                            msoAlertButtonAbortRetryIgnore, _
                            msoAlertIconCritical, _
                            msoAlertDefaultSecond

        MyUniMsgBox TieuDe, NoiDung & .[B7], _
                            msoAlertButtonYesAllNoCancel, _
                            msoAlertIconWarning, _
                            msoAlertDefaultFourth

Các bạn sẽ thấy có quá nhiều thủ tục trong hàm, làm sao nhớ đây? Đơn giản thôi, các bạn chỉ cần nhớ cấu trúc:

MyUniMsgBox Tiêu đề (bắt buộc), [Nội dung], [Kiểu nút lệnh], [Kiểu Icon], [Kiểu nút lệnh mặc định]

Các kiểu trong dấu ngoặc móc là không bắt buộc, có hay không cũng không thành vấn đề, tùy theo kiểu thông báo mà các bạn thêm hoặc bớt.

Nhưng các bạn vẫn còn thắc mắc là trong cấu trúc có nhiều tiếng Anh khó nhớ quá, xin thưa là không có vấn đề gì, cứ sau khi đặt dấu phẩy sau Tiêu đề là nó sẽ hiển thị các List Constants cho các bạn lựa chọn!





Chúc các bạn có các thông báo thật Việt Nam!

 

[Hoàng Trọng Nghĩa]

À, cũng nói thêm, với MsgBox của Application, bạn có thể viết như vầy:

Assistant.DoAlert "THÔNG BÁO", UniConvert(Text, "VNI"), 0, 79, 0, 0, 0

Với cái số 79 là Icon của nó. Nó có thể có rất nhiều Icon, tôi nhắm cả trăm hơn trăm chứ không ít đâu nhé!

 

[quyenpv]

Không chạy được trên Office 64 bít hả anh

 

[Hoàng Trọng Nghĩa]

Không chạy được trên Office 64 bít hả anh

Tôi sẽ sớm up file có thể chạy trên 64bit mặc dù tôi không có máy để test!

 

[langtuchungtinh360]

Không chạy được trên Office 64 bít hả anh

bạn thay thế khúc bên trên dòng này
Private hHook As Long
thành thế này nha.

#If VBA7 Then
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" _
                                            (ByVal hDlg As LongPtr, _
                                             ByVal nIDDlgItem As LongPtr, _
                                             ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                            (ByVal idHook As LongPtr, _
                                             ByVal lpfn As LongPtr, _
                                             ByVal hmod As LongPtr, _
                                             ByVal dwThreadId As LongPtr) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
#Else
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" _
                                            (ByVal hDlg As Long, _
                                             ByVal nIDDlgItem As Long, _
                                             ByVal lpString As String) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If

 

[Hoàng Trọng Nghĩa]

bạn thay thế khúc bên trên dòng này
Private hHook As Long
thành thế này nha.

#If VBA7 Then
    Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" _
                                            (ByVal hDlg As LongPtr, _
                                             ByVal nIDDlgItem As LongPtr, _
                                             ByVal lpString As String) As Long
    Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
                                            (ByVal idHook As LongPtr, _
                                             ByVal lpfn As LongPtr, _
                                             ByVal hmod As LongPtr, _
                                             ByVal dwThreadId As LongPtr) As Long
    Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long
#Else
    Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextW" _
                                            (ByVal hDlg As Long, _
                                             ByVal nIDDlgItem As Long, _
                                             ByVal lpString As String) 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 UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
#End If

Cái này đã test kỹ chưa bạn? Tôi sẽ dùng nó để cập nhật bản mới nhé!

 

[langtuchungtinh360]

Cái này đã test kỹ chưa bạn? Tôi sẽ dùng nó để cập nhật bản mới nhé!

Office em 64 bit mà thầy ^^