Chỉnh Font của MsgBox trong Windows

[hanhpptc]

Nhờ các bạn giúp Code (VBA) trong Excel can thiệp chỉnh Font của MsgBox trong Window giúp mình với. Cụ thể là như thế này: Minh đang viết các Msg bằng mã Unicode, vấn đề là ở chổ mỗi máy thiết lập font trong Msg khác nhau, ý muốn của mình là khi mở file Excel thì ghi nhận lại font hiển thị Msg hiện hành trong Win, đồng thời chỉnh sang font Unicode. Khi thoát excel thì trả lại moi trường cũ. Loay hoay mãi mà chưa được (do có nhiều phần mềm tự can thiệp các font hệ thống)

 

[Hai Lúa Miền Tây]

Bạn xem bài sau thử nhé
[h=1]Function UniVBA và MsgUni hỗ trợ nhập tiếng việt (Font Unicode) trong VBA[/h]

 

[Hoàng Trọng Nghĩa]

Bạn xem bài sau thử nhé
Function UniVBA và MsgUni hỗ trợ nhập tiếng việt (Font Unicode) trong VBA

Cái này có liên quan gì đến bài hỏi đâu ta? Ý người ta nói đã có code chuyển mã tiếng Việt, nhưng không muốn điều chỉnh trong font hệ thống, muốn có một code chuyển font hệ thống khi msgbox hiện ra và reset lại khi thoát msgbox đó!

 

[hanhpptc]

Cái này có liên quan gì đến bài hỏi đâu ta? Ý người ta nói đã có code chuyển mã tiếng Việt, nhưng không muốn điều chỉnh trong font hệ thống, muốn có một code chuyển font hệ thống khi msgbox hiện ra và reset lại khi thoát msgbox đó!

Ý của bạn minhthien321 đúng với cái mình cần. Song không nhất thiết phải làm nhiều lần khi hiện và thoát Msgbox. Chỉ cần can thiệp lúc mở và đóng File là được

 

[ndu96081631]

Ý của bạn minhthien321 đúng với cái mình cần. Song không nhất thiết phải làm nhiều lần khi hiện và thoát Msgbox. Chỉ cần can thiệp lúc mở và đóng File là được

Tôi thấy các chương trình lớn cũng ít khi làm điều này. Muốn xài chương trình thì "buộc" phải đưa font hệ thống về mặc định như lúc ta mới cài Windows ---> Việc chúng ta tự chỉnh font hệ thống (hoặc do chương trình tào lao nào đó can thiệp) thì ta tự gánh chịu hậu quả
Nói chung việc chỉnh lại font hệ thống cũng chẳng dễ ăn tí nào (khác nhau trên từng phiên bản Windows). Thôi thì ta tự chỉnh bằng tay vậy

 

[Hoàng Trọng Nghĩa]

Ý của bạn minhthien321 đúng với cái mình cần. Song không nhất thiết phải làm nhiều lần khi hiện và thoát Msgbox. Chỉ cần can thiệp lúc mở và đóng File là được

Tôi không đủ trình độ để thực hiện điều này, nhưng nếu can thiệp vào hệ thống mà không trả lại như cũ liền thì lỡ khi mở các chương trình khác đang thực hiện cùng với file của mình, biết đâu font sẽ bị lộn xộn cả lên. Chỉ là ý kiến của mình.

 

[hanhpptc]

Tôi thấy các chương trình lớn cũng ít khi làm điều này. Muốn xài chương trình thì "buộc" phải đưa font hệ thống về mặc định như lúc ta mới cài Windows ---> Việc chúng ta tự chỉnh font hệ thống (hoặc do chương trình tào lao nào đó can thiệp) thì ta tự gánh chịu hậu quả
Nói chung việc chỉnh lại font hệ thống cũng chẳng dễ ăn tí nào (khác nhau trên từng phiên bản Windows). Thôi thì ta tự chỉnh bằng tay vậy

Mình cũng rất ghét cái việc can thiệp vào font hệ thống, thích mặc định của window hơn. Khổ nổi nhiều chương trình khác tự can thiệp nên mới có yêu cầu này. Thôi làm bằng tay vậy. Cám ơn các bạn trên diễn đàn

 

[paulsteigel]

Tôi hoàn toàn đồng ý việc không nên can thiệp vào hệ thống mà nên sử dụng các tính năng đã có. Nếu muốn hiển thị msg tiếng Việt thì diễn đàn này đã có đầy giải pháp rùi còn gì...
Tiện đây, để giúp bạn giải quyết vấn đề này xin chia sẻ với bạn cách tôi hay dùng trong Access và một gợi ý của một bác trong GPE.
Để dùng module dưới đây, bạn cần đặt tham chiếu ứng dụng đến thư viện MSO.dll của Office (Microsoft Office xx.0 Object library) trong đó xx là phiên bản - thường cái này có mặc định trong dự án.
Bạn dùng Module này nhé. Khi gọi chỉ cần dùng
Msgbox "Thông điệp", vbCritical+vbOKCancel '- đối với dạng thông điệp
hoặc
Msgbox ("Thông điệp", vbCritical+vbOKCancel) '- đối với dạng hàm

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

' Application title
Private Const xApp_Title = "MIS Application"

Function MsgBox(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle) As VbMsgBoxResult
    Beep
    Dim iVal As VbMsgBoxStyle, msgBoxIcon As MsoAlertIconType, msgButton As MsoAlertButtonType
    iVal = msgStyle
    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
  
    Select Case iVal
    Case 4:
        msgButton = msoAlertButtonYesNo
    Case 3:
        msgButton = msoAlertButtonYesNoCancel
    Case 1:
        msgButton = msoAlertButtonOKCancel
    Case 0:
        msgButton = msoAlertButtonOK
    End Select
    ' Set Hook
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    ' Display the messagebox
    MsgBox = Application.Assistant.DoAlert(xApp_Title, MessageTxt, msgButton, msgBoxIcon, msoAlertDefaultFirst, 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
        'Hàm StrConv để chuyển chuỗi tiếng Việt sang dạng Unicode, hàm SetDlgItemText trên kia có Alias là W đối với thông điệp Unicode.
        StrYes = "&C" & ChrW(243)
        StrNo = "&Kh" & ChrW(244) & "ng"
        StrOK = ChrW(272) & ChrW(7891) & "&ng " & ChrW(253)
        StrCancel = "&H" & ChrW(7911) & "y"

        SetDlgItemText wParam, IDYES, StrConv(StrYes, vbUnicode)
        SetDlgItemText wParam, IDNO, StrConv(StrNo, vbUnicode)
        SetDlgItemText wParam, IDCANCEL, StrConv(StrCancel, vbUnicode)
        SetDlgItemText wParam, IDOK, StrConv(StrOK, vbUnicode)
        ' Release the Hook
        UnhookWindowsHookEx hHook
    End If
    MsgBoxHookProc = False
End Function

 

[Hoàng Trọng Nghĩa]

Tôi hoàn toàn đồng ý việc không nên can thiệp vào hệ thống mà nên sử dụng các tính năng đã có. Nếu muốn hiển thị msg tiếng Việt thì diễn đàn này đã có đầy giải pháp rùi còn gì...
Tiện đây, để giúp bạn giải quyết vấn đề này xin chia sẻ với bạn cách tôi hay dùng trong Access và một gợi ý của một bác trong GPE.
Để dùng module dưới đây, bạn cần đặt tham chiếu ứng dụng đến thư viện MSO.dll của Office (Microsoft Office xx.0 Object library) trong đó xx là phiên bản - thường cái này có mặc định trong dự án.
Bạn dùng Module này nhé. Khi gọi chỉ cần dùng
Msgbox "Thông điệp", vbCritical+vbOKCancel '- đối với dạng thông điệp
hoặc
Msgbox ("Thông điệp", vbCritical+vbOKCancel) '- đối với dạng hàm

1) Cái msgbox này hình như còn thiếu cái Title, bạn có thể thêm vào không?

2) Nếu thêm những thứ dưới đây phải viết làm sao ta?

msoAlertButtonAbortRetryIgnore

msoAlertButtonRetryCancel

 

[Hoàng Trọng Nghĩa]

Tự trả lời:

Vấn đề 1:

Mình thử cái này thì OK, bỏ cái const này: Private Const xApp_Title = "MIS Application"

Thay vào đó:
Function MsgBoxNew(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle, Optional xApp_Title As String) As VbMsgBoxResult

cấu trúc:

MsgBoxNew MessageTxt, vbYesNoCancel + vbCritical, xApp_Title


Vấn đề 2:

Function MsgBoxNew(MessageTxt As String, Optional msgStyle As VbMsgBoxStyle, Optional xApp_Title As String) As VbMsgBoxResult
    Beep
    Dim iVal As VbMsgBoxStyle, msgBoxIcon As MsoAlertIconType, msgButton As MsoAlertButtonType
    iVal = msgStyle
    Select Case msgStyle
    [B][COLOR=#0000cd]Case 16 To 21[/COLOR][/B] ' Critical case
        iVal = iVal - 16
        msgBoxIcon = msoAlertIconCritical
    [B][COLOR=#0000cd]Case 32 To 37[/COLOR][/B] ' Question case
        iVal = iVal - 32
        msgBoxIcon = msoAlertIconQuery
    [COLOR=#0000cd][B]Case 48 To 53[/B][/COLOR] ' Exclamation case
        iVal = iVal - 48
        msgBoxIcon = msoAlertIconWarning
    [B][COLOR=#0000cd]Case 64 To 69[/COLOR][/B] ' Information case
        iVal = iVal - 64
        msgBoxIcon = msoAlertIconInfo
    End Select
    
    Select Case iVal
        Case 0: msgButton = msoAlertButtonOK
        Case 1: msgButton = msoAlertButtonOKCancel
[B][COLOR=#0000cd]        Case 2: msgButton = msoAlertButtonAbortRetryIgnore[/COLOR][/B]
        Case 3: msgButton = msoAlertButtonYesNoCancel
        Case 4: msgButton = msoAlertButtonYesNo
[COLOR=#0000cd][B]        Case 5: msgButton = msoAlertButtonRetryCancel[/B][/COLOR]
    End Select
    ' Set Hook
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    ' Display the messagebox
    MsgBoxNew = Application.Assistant.DoAlert(xApp_Title, MessageTxt, msgButton, msgBoxIcon, msoAlertDefaultFirst, msoAlertCancelDefault, 0)
End Function

Dĩ nhiên phải thêm 1 số chi tiết cho nó nữa:

        SetDlgItemText wParam, IDOK, StrConv(StrOK, vbUnicode)
        SetDlgItemText wParam, IDCANCEL, StrConv(StrCancel, vbUnicode)
[COLOR=#0000cd][B]        SetDlgItemText wParam, IDABORT, StrConv(StrAbort, vbUnicode)
        SetDlgItemText wParam, IDRETRY, StrConv(StrRetry, vbUnicode)
        SetDlgItemText wParam, IDIGNORE, StrConv(StrIgnore, vbUnicode)[/B][/COLOR]
        SetDlgItemText wParam, IDYES, StrConv(StrYes, vbUnicode)
        SetDlgItemText wParam, IDNO, StrConv(StrNo, vbUnicode)

Xét cho cùng thì cũng hiển thị theo hệ thống, nếu font hệ thống thay đổi (không phải font Unicode) thì sẽ bị lỗi font.

Thủ tục của bạn paulsteigel rất hay ở điểm làm mượt mà các nút lệnh bằng MsgBox của Application và mã hóa các nút đó bằng tiếng Việt.

 

[Hoàng Trọng Nghĩa]

Nếu muốn bỏ cái "icon" trắng ở Title của MsgBox, chỉ cần thay True thành False là ổn:

Thay vì:

MsgBoxNew = Application.Assistant.DoAlert(xApp_Title, MessageTxt, msgButton, msgBoxIcon, msoAlertDefaultFirst, msoAlertCancelDefault, True)

Thì chuyển thành:

MsgBoxNew = Application.Assistant.DoAlert(xApp_Title, MessageTxt, msgButton, msgBoxIcon, msoAlertDefaultFirst, msoAlertCancelDefault, False)

 

[Hoàng Trọng Nghĩa]

Tôi hoàn toàn đồng ý việc không nên can thiệp vào hệ thống mà nên sử dụng các tính năng đã có. Nếu muốn hiển thị msg tiếng Việt thì diễn đàn này đã có đầy giải pháp rùi còn gì...
Tiện đây, để giúp bạn giải quyết vấn đề này xin chia sẻ với bạn cách tôi hay dùng trong Access và một gợi ý của một bác trong GPE.
Để dùng module dưới đây, bạn cần đặt tham chiếu ứng dụng đến thư viện MSO.dll của Office (Microsoft Office xx.0 Object library) trong đó xx là phiên bản - thường cái này có mặc định trong dự án.
Bạn dùng Module này nhé. Khi gọi chỉ cần dùng
Msgbox "Thông điệp", vbCritical+vbOKCancel '- đối với dạng thông điệp
hoặc
Msgbox ("Thông điệp", vbCritical+vbOKCancel) '- đối với dạng hàm

Tôi đã nghiên cứu kỹ cái Application.Assistant.DoAlert này rồi, nhưng không cách nào làm được chuyện cho nó không hoạt động nút Close như Msgbox thông thường (như ta chọn vbYesNo, tự động nó không cho sử dụng nút Close). Vậy bằng cách nào mình mới có thể khóa nút close vậy?

Xin được các bạn hướng dẫn. Cám ơn.