'---------------------------------------------------------------------------------------' Ten Module : MsgBoxTV
' Tac gia : Hoang Trong Nghia
' Ngày : 2/17/2016
' Chu thich : Ham UniBox Tieng Viet
'---------------------------------------------------------------------------------------
Option Explicit
'******************************************************************************************************************************
'-----------------------------------------------------------------------------------------------------
'--Cau truc: UniBox TieuDe (bat buoc), [NoiDung], [KieuNutLenh], [KieuIcon], [KieuNutLenhMacDinh]
'-----------------------------------------------------------------------------------------------------
'******************************************************************************************************************************
#If VBA7 Or Win64 Then 'Office 64-bit
Private hHook As LongPtr
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 hHook As Long
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
'******************************************************************************************************************************
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 StrOK As String
Private StrCancel As String
Private StrAbort As String
Private StrRetry As String
Private StrIgnore As String
Private StrYes As String
Private StrNo As String
Private StrYesAll As String
'******************************************************************************************************************************
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal _
lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
'De biet Charcode, dung ham ASCW("KyTu")
[B] StrOK = "Ch" & ChrW(7845) & "p nh" & ChrW(7853) & "n" 'Chap nhan
StrCancel = "&H" & ChrW$(7911) & "y b" & ChrW$(7887) 'Huy bo
StrAbort = "&H" & ChrW$(7911) & "y ngang" 'Huy ngang
StrRetry = "&Th" & ChrW$(7917) & " l" & ChrW$(7841) & "i" 'Thu lai
StrIgnore = "&B" & ChrW$(7887) & " qua" 'Bo qua
StrYes = "&Có" 'Co
StrNo = "&Không" 'Khong
StrYesAll = "Có &t" & ChrW$(7845) & "t c" & ChrW$(7843) 'Co tat ca[/B]
'--------------------------------------------------------------------------
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
'******************************************************************************************************************************
Function UniBox(Optional ByVal MsgTitle_Tieu_De As String = "", Optional MsgText_Noi_Dung As String, Optional _
msgButtonType As MsoAlertButtonType, Optional msgIconType As MsoAlertIconType, _
Optional msgDefaultType As MsoAlertDefaultType) As VbMsgBoxResult
'-----------------------------------------------------------------------------------------------------
'--Cau truc: UniBox TieuDe (bat buoc), [NoiDung], [KieuNutLenh], [KieuIcon], [KieuNutLenhMacDinh]
'-----------------------------------------------------------------------------------------------------
If Len(MsgTitle_Tieu_De) = 0 Then MsgTitle_Tieu_De = "Thông báo"
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, _
GetCurrentThreadId)
On Error Resume Next
UniBox = Assistant.DoAlert(MsgTitle_Tieu_De, MsgText_Noi_Dung, msgButtonType, msgIconType, _
msgDefaultType, msoAlertCancelDefault, False)
If Err.Number Then
Err.Clear
UniBox = Assistant.DoAlert(MsgTitle_Tieu_De, MsgText_Noi_Dung, msgButtonType, _
msgIconType, msoAlertDefaultFirst, msoAlertCancelDefault, False)
End If
End Function
'******************************************************************************************************************************
Function UniInputBox(Optional ByVal MsgTitle_Tieu_De As String = "", Optional MsgText_Noi_Dung As String, _
Optional msgButtonType As MsoAlertButtonType, Optional msgIconType As _
MsoAlertIconType, Optional msgDefaultType As MsoAlertDefaultType) As String
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, _
GetCurrentThreadId)
Dim con As String
Rep:
On Error Resume Next
UniInputBox = Application.InputBox(MsgText_Noi_Dung, MsgTitle_Tieu_De)
If Len(UniInputBox) = 0 Then GoTo Err
Exit Function
Err:
UniBox "Thông báo", "Kh" & ChrW(244) & "ng th" & ChrW(7875) & " b" & _
ChrW(7887) & " tr" & ChrW(7889) & "ng n" & ChrW(7897) & "i dung."
GoTo Rep
End Function
Sub dfgfdg()
UniBox , "Noi DUng"
End Sub
