Option Explicit
'------------------------------------------------------------------------
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
,,,,
