'------------------------------------------------------------------------
Private hHook As Long
'******************************************************************************************************************************
#If VBA7 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 LongPtr) 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 Long) 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
'******************************************************************************************************************************
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
''------------------------------------------------------------------------
Private Const IdOK = 1
Private Const IdCancel = 2
Private Const IdAbort = 3
Private Const IdRetry = 4
Private Const IdIgnore = 5
Private Const IdYes = 6
Private Const IdNo = 7
Private Const IdYesAll = 8
'------------------------------------------------------------------------
Private Const strAllButton As String = "63006800e2004103700020006e006800e20023036e00,6800e71e790020006200cf1e,6800e71e790020006e00670061006e006700,74006800ed1e20006c00a11e6900,4200cf1e2000710075006100,4300f300,6b006800f4006e006700,4300f30020007400a51e740020006300a31e"
'******************************************************************************************************************************
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Long
Dim strButton() As String
If lMsg = HCBT_ACTIVATE Then
strButton = Split(strAllButton, ",")
For i = IdOK To IdYesAll
SetDlgItemText wParam, i, StrPtr(HexASCIIToString(strButton(i - 1)))
Next i
UnhookWindowsHookEx hHook
End If
MsgBoxHookProc = False
End Function
'******************************************************************************************************************************
Function MyUniMsgBox(ByVal msgTitle As String, _
Optional msgText As String, _
Optional msgButtonType As MsoAlertButtonType, _
Optional msgIconType As MsoAlertIconType, _
Optional msgDefaultType As MsoAlertDefaultType) As VbMsgBoxResult
''---------------------------------------------------------------------------------------------------
''Cau truc: MyUniMsgBox TieuDe (bat buoc), [NoiDung], [KieuNutLenh], [KieuIcon], [KieuNutLenhMacDinh]
''---------------------------------------------------------------------------------------------------
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
On Error Resume Next
MyUniMsgBox = Assistant.DoAlert(msgTitle, _
msgText, _
msgButtonType, _
msgIconType, _
msgDefaultType, _
msoAlertCancelDefault, _
False)
If Err.Number Then
Err.Clear
MyUniMsgBox = Assistant.DoAlert(msgTitle, _
msgText, _
msgButtonType, _
msgIconType, _
msoAlertDefaultFirst, _
msoAlertCancelDefault, _
False)
End If
End Function
'******************************************************************************************************************************
Private Function HexASCIIToString(ByVal strASCII As String) As String
Dim i As Long
Dim K As Long
Dim bytArr() As Byte
i = Len(strASCII) \ 2
If i > 0 Then
ReDim bytArr(0 To i - 1)
For i = 1 To Len(strASCII) - 1 Step 2
bytArr(K) = CLng("&H" & Mid$(strASCII, i, 2))
K = K + 1
Next i
End If
HexASCIIToString = bytArr()
End Function
Sub Main_MyUniMsgBox()
Dim Str1 As String, KM As String, KT As String
Str1 = "Written by Hoàng Tr" & ChrW(7885) & "ng Ngh" & ChrW(297) & "a" & vbCrLf _
& "Gi" & ChrW(7843) & "i Pháp Excel Công C" & ChrW(7909) & " Tuy" & ChrW(7879) _
& "t V" & ChrW(7901) & "i C" & ChrW(7911) & "a B" & ChrW(7841) & "n !!!"
KM = "Ngh" & ChrW(297) & "a " & ChrW(272) & ChrW(7865) & "p Trai"
KT = MyUniMsgBox(KM, Str1, 3, 111) ''<- Thay doi Tham So Sau no lay ICO Sytem32 cua Win
If KT = vbYes Then
MsgBox "Ban Chon Co", , "Thông Báo"
ElseIf KT = vbCancel Then
MsgBox "Ban Chon Huy Bo", , "Thông Báo"
Else
MsgBox "Ban Chon Khong", , "Thông Báo"
End If
End Sub
Sub Main2_MyUniMsgBox()
Dim Str1 As String, KM As String, KT As String
Str1 = "Written by Hoàng Tr" & ChrW(7885) & "ng Ngh" & ChrW(297) & "a" & vbCrLf _
& "Gi" & ChrW(7843) & "i Pháp Excel Công C" & ChrW(7909) & " Tuy" & ChrW(7879) _
& "t V" & ChrW(7901) & "i C" & ChrW(7911) & "a B" & ChrW(7841) & "n !!!"
KM = "Ngh" & ChrW(297) & "a " & ChrW(272) & ChrW(7865) & "p Trai"
KT = MyUniMsgBox(KM, Str1, msoAlertIconInfo, 14)
If KT = vbYes Then
MsgBox "Ban Chon Co", , "Thông Báo"
Else
MsgBox "Ban Chon Khong", , "Thông Báo"
End If
End Sub
Function UniMsgbox(Optional ByVal TieuDe As String = "", Optional ByVal NoiDung As String, _
Optional ByVal Buuton As Long, Optional ByVal Icon As Long)
Rem Cau truc: UniMsgBox [Tieu De], [Noi Dung], [Kieu Nut Lenh], [Kieu Icon]
If TieuDe = "" Then TieuDe = ("Th" & ChrW(244) & "ng B" & ChrW(225) & "o") ''Thông Báo
UniMsgbox = MyUniMsgBox(TieuDe, NoiDung, Buuton, Icon)
End Function
Sub Main_UniMsgbox()
Dim TB As String, NoiDung As String, x
TB = "Thông Báo"
NoiDung = "Ki" & ChrW(7873) & "u M" & ChrW(7841) & "nh" _
& vbLf & "Tr" & ChrW(226) & "n Tr" & ChrW(7885) & "ng Th" & ChrW(244) & "ng B" & ChrW(225) & "o"
x = UniMsgbox(TB, NoiDung, 3, 111)
If x = vbYes Then
MsgBox "Yes"
ElseIf x = vbNo Then
MsgBox "No"
Else
MsgBox "Cancel"
End If
End Sub
