- Tham gia
- 17/8/08
- Bài viết
- 8,662
- Được thích
- 16,720
- Giới tính
- Nam
Nếu như ở bài này:
http://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:
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:
Thật tuyệt vời phải không các bạn?
http://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:
Mã:
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:
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, ButtonCancelThật tuyệt vời phải không các bạn?
Mã:
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
Lần chỉnh sửa cuối:
