paulsteigel > 12-10-13, 11:08 AM
Select Case msgStyle
Case 20, 19, 17, 16: ' Critical case
iVal = iVal - 16
msgBoxIcon = msoAlertIconCritical
Case 36, 35, 33, 32: ' Question case
iVal = iVal - 32
msgBoxIcon = msoAlertIconQuery
Case 52, 51, 49, 48: ' Exclamation case
iVal = iVal - 48
msgBoxIcon = msoAlertIconWarning
Case 68, 67, 65, 64: ' Information case
iVal = iVal - 64
msgBoxIcon = msoAlertIconInfo
End Select
msgbox "hi",vbYesNoCancel +vbDefaultButton3 +vbCritical
Minh Tiên > 12-10-13, 06:22 PM
paulsteigel > 14-10-13, 11:07 PM
Option Explicit
'=======================================================
' Module for Vietnamized MsgBox function
' This overides default VBA MsgBox function with some small
' modifications of text, button caption....
' Use this MsgBox function like it is in default VBA IDE
'=======================================================
' Import
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
' Handle to the Hook procedure
Private hHook As Long
' Hook type
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
' Constants
Public Const IDOK = 1
Public Const IDCANCEL = 2
Public Const IDABORT = 3
Public Const IDRETRY = 4
Public Const IDIGNORE = 5
Public Const IDYES = 6
Public Const IDNO = 7
' Modify this code for English
Private StrYes As String
Private StrNo As String
Private StrOK As String
Private StrCancel As String
Private StrRetry As String
Private StrIgnore As String
Private StrAbort As String
' Application title
Private Const App_Title = "MsgBox Demo function..."
Function MsgBox(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle, Optional DlgCaption As String = "") As VbMsgBoxResult
Beep
Dim msgBoxIcon As Long, msgButton As Long, btnStyle As Long, ErrLoop As Boolean
Dim ButtonDefault As Long
' Determine what button is default....
Dim btnArr As Variant, i As Long
btnArr = Array(0, 256, 512, 768)
For i = 0 To UBound(btnArr)
btnStyle = msgStyle - btnArr(i)
If btnStyle < 0 Then
ButtonDefault = i - 1
btnStyle = msgStyle - btnArr(i - 1)
ErrLoop = True
Exit For
End If
Next
' Determine Icon...
btnArr = Array(0, 16, 32, 48, 64)
For i = 0 To UBound(btnArr)
msgButton = btnStyle - btnArr(i)
If msgButton <= 0 Then
If msgButton = 0 Then
msgBoxIcon = i
btnStyle = btnStyle - btnArr(i)
Else
msgBoxIcon = i - 1
btnStyle = btnStyle - btnArr(i - 1)
End If
ErrLoop = True
Exit For
End If
Next
If ErrLoop Then
' get the button style
If msgButton < 0 Then msgButton = btnStyle
' clear error if number of button is smaller than the default setting...
If ButtonDefault > msgButton Then ButtonDefault = msgButton
Else
ButtonDefault = 0
msgButton = 0
msgBoxIcon = 0
End If
' Set Hook
hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
' Display the messagebox
MsgBox = Application.Assistant.DoAlert(IIf(DlgCaption <> "", DlgCaption, Application.Name), _
MessageTxt, msgButton, msgBoxIcon, ButtonDefault, msoAlertCancelDefault, True)
End Function
Private Function MsgBoxHookProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If lMsg = HCBT_ACTIVATE Then
StrYes = "&C" & ChrW(243)
StrNo = "&Kh" & ChrW(244) & "ng"
StrOK = "Ch" & ChrW(7845) & "p nh" & ChrW(7853) & "&n"
StrCancel = "&H" & ChrW(7911) & "y"
StrRetry = "&Th" & ChrW(7917) & " l" & ChrW(7841) & "i"
StrAbort = "&D" & ChrW(7915) & "ng"
StrIgnore = "&B" & ChrW(7887) & " qua"
SetDlgItemText wParam, IDYES, StrConv(StrYes, vbUnicode)
SetDlgItemText wParam, IDNO, StrConv(StrNo, vbUnicode)
SetDlgItemText wParam, IDCANCEL, StrConv(StrCancel, vbUnicode)
SetDlgItemText wParam, IDOK, StrConv(StrOK, vbUnicode)
SetDlgItemText wParam, IDABORT, StrConv(StrAbort, vbUnicode)
SetDlgItemText wParam, IDRETRY, StrConv(StrRetry, vbUnicode)
SetDlgItemText wParam, IDIGNORE, StrConv(StrIgnore, vbUnicode)
' Release the Hook
UnhookWindowsHookEx hHook
End If
MsgBoxHookProc = False
End Function
Minh Tiên > 15-10-13, 11:49 AM
Minh Tiên > 27-10-13, 12:23 PM
paulsteigel > 27-10-13, 12:55 PM
Minh Tiên > 27-10-13, 01:41 PM
(27-10-13, 12:55 PM)paulsteigel Đã viết: Tôi dùng với office 2003, 2010 thì không thấy có hiện tượng này. Có thể bạn kiểm tra kỹ nhé - 1 không được trùng ký tự, 2 không dùng ký tự tiếng việt (Đ, ậ ..) làm phím tắt. Bạn thử nhấn Alt xem phím tắt có nổi lên không nhé.
Có gì bạn cứ phản hồi!