Tặng Hàm MsgBox Việt hóa font Unicode chỉnh nút lệnh theo ý muốn! (Phần 3)

hands
02/11/2015
Excel Ứng Dụng

Nếu như ở bài này:

[URL='https://www.giaiphapexcel.com/forum/showthread.php?109175-T%E1%BA%B7ng-H%C3%A0m-MsgBox-Vi%E1%BB%87t-h%C3%B3a-font-Unicode-tuy%E1%BB%87t-%C4%91%E1%BA%B9p%21-%28Ph%E1%BA%A7n-2-32bit-64bit%29&p=682368#post682368']https://www.giaiphapexcel.com/forum/showthread.php?109175-Tặng-Hàm-MsgBox-Việt-hóa-font-Unicode-tuyệt-đẹp!-(Phần-2-32bit-64bit)&p=682368#post682368

Ta đã có một hàm chuyển hóa Việt ngữ dùng cho cả 32 lẫn 64 bit, thì bài này tôi tiếp tục nâng cấp chúng gọn hơn với các thủ tục, đồng thời ta có thể thay đổi tên nút lệnh ngay tại câu lệnh của chúng ta!

Đây là toàn bộ code:

Option Explicit
''------------------------------------------------------------------------
Private hHook As Long
Private priBttnArr, priChangeBttnArr
''------------------------------------------------------------------------
Private Const HCBT_ACTIVATE = 5
'******************************************************************************************************************************
#If VBA7 And Win64 Then 'Office 64-bit
    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 ' Office 32-bit
    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
'******************************************************************************************************************************
Public Enum ButtonType
    bttnOK = 0      ': OK
    bttnOC = 1      ': OKCancel
    bttnARI = 2     ': AbortRetryIgnore
    bttnYNC = 3     ': YesNoCancel
    bttnYN = 4      ': YesNo
    bttnRC = 5      ': RetryCancel
    bttnYANC = 6    ': YesAllNoCancel
End Enum

Public Enum IconType
    iconNoIcon = 0
    iconCritical = 1
    iconQuery = 2
    iconWarning = 3
    iconInfo = 4
End Enum

Public Enum DefaultType
    dfltFirst = 0
    dfltSecond = 1
    dfltThird = 2
    dfltFourth = 3
    dfltFifth = 4
End Enum
'******************************************************************************************************************************

Private Sub GetButtonString()
    If Not IsArray(priBttnArr) Then
        Dim OK As String, Cancel As String, Abort As String, Retry As String
        Dim Ignore As String, Yes As String, No As String, YesAll As String
        '-------------------------------------------------------------------
        OK = "Ch" & ChrW(7845) & "p nh" & ChrW(7853) & "n"       'Chap nhan
        Cancel = "&H" & ChrW$(7911) & "y b" & ChrW$(7887)        'Huy bo
        Abort = "&H" & ChrW$(7911) & "y ngang"                   'Huy ngang
        Retry = "&Th" & ChrW$(7917) & " l" & ChrW$(7841) & "i"   'Thu lai
        Ignore = "&B" & ChrW$(7887) & " qua"                     'Bo qua
        Yes = "&Có"                                              'Co
        No = "&Không"                                            'Khong
        YesAll = "Có &t" & ChrW$(7845) & "t c" & ChrW$(7843)     'Co tat ca
        '-------------------------------------------------------------------
        ReDim priBttnArr(1 To 8) As String
        '-------------------------------------------------------------------
        priBttnArr(1) = OK
        priBttnArr(2) = Cancel
        priBttnArr(3) = Abort
        priBttnArr(4) = Retry
        priBttnArr(5) = Ignore
        priBttnArr(6) = Yes
        priBttnArr(7) = No
        priBttnArr(8) = YesAll
        '-------------------------------------------------------------------
    End If
    priChangeBttnArr = priBttnArr
End Sub

Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    If lMsg = HCBT_ACTIVATE Then
        ''------------------------------------------------------------------------
        Dim c As Byte
        For c = 1 To 8
            SetDlgItemText wParam, c, StrConv(priChangeBttnArr(c), vbUnicode)
        Next
        ''------------------------------------------------------------------------
        UnhookWindowsHookEx hHook
    End If
    MsgBoxHookProc = False
End Function
'******************************************************************************************************************************

Function MsgBoxVN(ByVal msgTitle As String, _
                  ByVal msgText As String, _
                  ByVal msgButton As ButtonType, _
                  ByVal msgIcon As IconType, _
                  ByVal msgDefault As DefaultType, _
                  ParamArray msgButtonChange()) As VbMsgBoxResult
    ''---------------------------------------------------------------------------------------------------
    ''  Cau truc: MsgBoxVN (TieuDe, NoiDung, KieuNutLenh, KieuIcon, KieuNutLenhMacDinh,
[*])
    ''  Voi
[*]:
    ''  1) KHONG GHI GI CA Neu de mac dinh kieu Nut lenh da ma hoa san.
    ''  2) Ma hoa nut lenh bang chuoi Unicode tuy thich theo cac thu tu cua nut lenh.
    ''---------------------------------------------------------------------------------------------------
    On Error Resume Next
    Call GetButtonString
    If Not IsMissing(msgButtonChange) Then
        Select Case msgButton
        Case bttnOK     ': OK
            priChangeBttnArr(1) = Trim(msgButtonChange(0))
        Case bttnOC     ': OKCancel
            priChangeBttnArr(1) = Trim(msgButtonChange(0))
            priChangeBttnArr(2) = Trim(msgButtonChange(1))
        Case bttnARI    ': AbortRetryIgnore
            priChangeBttnArr(3) = Trim(msgButtonChange(0))
            priChangeBttnArr(4) = Trim(msgButtonChange(1))
            priChangeBttnArr(5) = Trim(msgButtonChange(2))
        Case bttnYNC    ': YesNoCancel
            priChangeBttnArr(6) = Trim(msgButtonChange(0))
            priChangeBttnArr(7) = Trim(msgButtonChange(1))
            priChangeBttnArr(2) = Trim(msgButtonChange(2))
        Case bttnYN     ': YesNo
            priChangeBttnArr(6) = Trim(msgButtonChange(0))
            priChangeBttnArr(7) = Trim(msgButtonChange(1))
        Case bttnRC     ': RetryCancel
            priChangeBttnArr(4) = Trim(msgButtonChange(0))
            priChangeBttnArr(2) = Trim(msgButtonChange(1))
        Case bttnYANC   ': YesAllNoCancel
            priChangeBttnArr(6) = Trim(msgButtonChange(0))
            priChangeBttnArr(8) = Trim(msgButtonChange(1))
            priChangeBttnArr(7) = Trim(msgButtonChange(2))
            priChangeBttnArr(2) = Trim(msgButtonChange(3))
        End Select
    End If
    hHook = SetWindowsHookEx(HCBT_ACTIVATE, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    MsgBoxVN = Assistant.DoAlert(msgTitle, msgText, msgButton, msgIcon, msgDefault, msoAlertCancelDefault, False)
End Function
'******************************************************************************************************************************

Như vậy, nếu bạn vẫn sử dụng mặc định nút lệnh tương đối dịch sát nghĩa của từ gốc thì chỉ cần:

MsgBoxVN TieuDe, NoiDung, bttnOK, 20, dfltFirst

Với bttnOK là nút có dòng chữ: Chấp nhận.

Nhưng ở đây chúng ta không muốn Chấp nhận, ta muốn theo cái thủ tục mà ta đưa ra như: Nội dung: Chúng ta sẽ làm gì? thì Button ta ghi "Ăn nhậu", "Thể thao", "Lao động" v.v…

Vậy chúng ta sẽ làm gì?

Với lần cải tiến này, chúng ta chỉ việc ghi thêm:

NoiDung = "Chúng ta sẽ làm gì?"
        ButtonYes ="Ăn nhậu"
        ButtonNo = "Thể thao"
        ButtonCancel = "Lao động"
        MsgBoxVN TieuDe, NoiDung, bttnYNC, 101, dfltThird, ButtonYes, ButtonNo, ButtonCancel

157

Thật tuyệt vời phải không các bạn?

NoiDung = "Thật tuyệt vời phải không các bạn?"
        ButtonYes ="Tuyệt thật"
        ButtonNo = "Hoàn hảo"
        MsgBoxVN TieuDe, NoiDung, bttnYN, 101, dfltThird, ButtonYes, ButtonNo

156

www.giaiphapexcel.com/diendan/threads/t%E1%BA%B7ng-h%C3%A0m-msgbox-vi%E1%BB%87t-h%C3%B3a-font-unicode-ch%E1%BB%89nh-n%C3%BAt-l%E1%BB%87nh-theo-%C3%BD-mu%E1%BB%91n-ph%E1%BA%A7n-3.109476/page-2#posts

Khóa học SprinGO phù hợp

Ứng dụng AI và Chat GPT trong Quản trị nhân sự

Học xong khóa này, học viên có thể: Hiểu đúng bản chất AI, các nhóm AI phổ biến và cách AI “hoạt động” ở...

Xem khóa học

Chia sẻ: