Cách Tạo Tiêu Đề Msgbox Là Chữ Đậm Hoặc Nghiêng

[Kiều Mạnh]

Mình đang sử dụng code sau để tạo Msgbox Uni tiếng viết có dấu bây giờ muốn chế biến thêm một tí là tạo chữ "Thông Báo" trên tiêu đề Msgbox thành chữ đậm hoặc chữ Nghiêng mà chưa được Mong các thành viên GPE trợ giúp

Xin cảm ơn
PS: nếu trên GPE có chủ đề này rồi thì cho mình xin Link

Public Sub MsgboxUni_TiengViet()
    CreateObject("WScript.Shell").PopUp "Ki" & ChrW(7873) & "u M" & ChrW(7841) & "nh Xin Chào", , "Thông Báo", vbInformation
End Sub

 

[Quang_Hải]

Mình đang sử dụng code sau để tạo Msgbox Uni tiếng viết có dấu bây giờ muốn chế biến thêm một tí là tạo chữ "Thông Báo" trên tiêu đề Msgbox thành chữ đậm hoặc chữ Nghiêng mà chưa được Mong các thành viên GPE trợ giúp

Xin cảm ơn
PS: nếu trên GPE có chủ đề này rồi thì cho mình xin Link

Public Sub MsgboxUni_TiengViet()
    CreateObject("WScript.Shell").PopUp "Ki" & ChrW(7873) & "u M" & ChrW(7841) & "nh Xin Chào", , "Thông Báo", vbInformation
End Sub

Cú pháp của phương thức Popup là thế này:

object.Popup (Message [, TimeOut][, Title] [, Format])

Cho nên chắc là sẽ không thể định dạng được tiêu đề đâu nhé.

 

[Kiều Mạnh]

Cú pháp của phương thức Popup là thế này:

object.Popup (Message [, TimeOut][, Title] [, Format])

Cho nên chắc là sẽ không thể định dạng được tiêu đề đâu nhé.

Có Em Thấy rồi mới nói ... quậy hết cách không được nên em mới hỏi
Hình Link Kèm
http://www.mediafire.com/download/7kffby2fohe7vn2/Msgbox_Chu_Dam.rar
PS: không hiểu sao Giờ Em Úp một File Text lên GPE cũng ko được nữa ....Nếu Bạn nào biết chỉ cách khắc phục
Xin Cảm ơn

 

[Kiều Mạnh]

Mình Siêu tầm code sau tạo Msgbox trên Access thấy giao diện dễ nhìn đẹp hơn object.Popup Msgbox ...

code chạy trên Access thì tốt nhưng mình chuyên qua Excel thì báo Lỗi ....code Access thì mình tịt ...vậy Úp lên nhờ các bạn chuyển code qua Xài trên Excel
Xin Cảm ơn

Function VietUniMsgBox(Prompt As String, _
 Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
 Optional Title As String = vbNullString, _
 Optional HelpFile As Variant, _
 Optional Context As Variant) _
 As VbMsgBoxResult
    If IsMissing(HelpFile) Or IsMissing(Context) Then
        FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
         """, " & Buttons & ", """ & Title & """)")
    Else
        FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
         """, " & Buttons & ", """ & Title & """, """ & _
         HelpFile & """, " & Context & ")")
    End If
End Function

Sub Test

Sub Test_Msgbox()
    VietUniMsgBox ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) _
    & "t!@Không l" & ChrW(7895) & "i Font Unicode ti" & ChrW(7871) & "ng Vi" _
    & ChrW(7879) & "t.@Có th" & ChrW(7875) & " t" & ChrW(7841) & "o ch" & _
    ChrW(7919) & " nét " & ChrW(273) & ChrW(7853) & "m.", vbCritical + _
    vbAbortRetryIgnore, "Msg Box Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
End Sub

File Kèm Link
http://www.mediafire.com/download/73gbb288adawvji/Msgbox_VBAUniCode.rar

 

[ndu96081631]

Mình Siêu tầm code sau tạo Msgbox trên Access thấy giao diện dễ nhìn đẹp hơn object.Popup Msgbox ...

code chạy trên Access thì tốt nhưng mình chuyên qua Excel thì báo Lỗi ....code Access thì mình tịt ...vậy Úp lên nhờ các bạn chuyển code qua Xài trên Excel
Xin Cảm ơn

Function VietUniMsgBox(Prompt As String, _
 Optional Buttons As VbMsgBoxStyle = vbOKOnly, _
 Optional Title As String = vbNullString, _
 Optional HelpFile As Variant, _
 Optional Context As Variant) _
 As VbMsgBoxResult
    If IsMissing(HelpFile) Or IsMissing(Context) Then
        FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
         """, " & Buttons & ", """ & Title & """)")
    Else
        FormattedMsgBox = Eval("MsgBox(""" & Prompt & _
         """, " & Buttons & ", """ & Title & """, """ & _
         HelpFile & """, " & Context & ")")
    End If
End Function

Sub Test

Sub Test_Msgbox()
    VietUniMsgBox ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) _
    & "t!@Không l" & ChrW(7895) & "i Font Unicode ti" & ChrW(7871) & "ng Vi" _
    & ChrW(7879) & "t.@Có th" & ChrW(7875) & " t" & ChrW(7841) & "o ch" & _
    ChrW(7919) & " nét " & ChrW(273) & ChrW(7853) & "m.", vbCritical + _
    vbAbortRetryIgnore, "Msg Box Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
End Sub

File Kèm Link
http://www.mediafire.com/download/73gbb288adawvji/Msgbox_VBAUniCode.rar

Viết vầy nè:

Function VietUniMsgBox(ByVal Prompt As String, _
                       Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                       Optional ByVal Title As String = vbNullString, _
                       Optional ByVal HelpFile As Variant, _
                       Optional ByVal Context As Variant) As VbMsgBoxResult
 [COLOR=#ff0000] Dim scrObj As Object[/COLOR]
  Dim FormattedMsgBox As Long
  [COLOR=#ff0000]Set scrObj = CreateObject("ScriptControl")[/COLOR]
  [COLOR=#ff0000]scrObj.Language = "VBScript"[/COLOR]
  If IsMissing(HelpFile) Or IsMissing(Context) Then
    FormattedMsgBox = [COLOR=#ff0000]scrObj.Eval[/COLOR]("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """)")
  Else
    FormattedMsgBox = [COLOR=#ff0000]scrObj.Eval[/COLOR]("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """, """ & HelpFile & """, " & Context & ")")
  End If
End Function

Sub Test_Msgbox()
 [COLOR=#0000cd] Dim Prompt As String, Title As String
  Dim Buttons As VbMsgBoxStyle[/COLOR]
  [COLOR=#0000cd]Prompt = ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) _
          & "t!@Không l" & ChrW(7895) & "i Font Unicode ti" & ChrW(7871) & "ng Vi" _
          & ChrW(7879) & "t.@Có th" & ChrW(7875) & " t" & ChrW(7841) & "o ch" & _
          ChrW(7919) & " nét " & ChrW(273) & ChrW(7853) & "m."
    
  Title = "Msg Box Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
  Buttons = vbCritical + vbAbortRetryIgnore[/COLOR]
  [COLOR=#0000cd]VietUniMsgBox Prompt, Buttons, Title[/COLOR]
End Sub

Chỗ màu đỏ là thêm vào: Eval dùng để biến 1 chuỗi chứa câu lệnh thành lệnh thực thi (cái này tôi cũng có viết mấy bài trên GPE rồi).
Công dụng của Eval gần giống như Evaluate biến chuỗi chứa biểu thức toán học thành kết quả tính toán của biểu thức ấy
Chỗ màu xanh: Code của đồng chí viết "xấu" quá, sửa lại cho "đẹp"

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Viết vầy nè:

Function VietUniMsgBox(ByVal Prompt As String, _
                       Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
                       Optional ByVal Title As String = vbNullString, _
                       Optional ByVal HelpFile As Variant, _
                       Optional ByVal Context As Variant) As VbMsgBoxResult
 [COLOR=#ff0000] Dim scrObj As Object[/COLOR]
  Dim FormattedMsgBox As Long
  [COLOR=#ff0000]Set scrObj = CreateObject("ScriptControl")[/COLOR]
  [COLOR=#ff0000]scrObj.Language = "VBScript"[/COLOR]
  If IsMissing(HelpFile) Or IsMissing(Context) Then
    FormattedMsgBox = [COLOR=#ff0000]scrObj.Eval[/COLOR]("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """)")
  Else
    FormattedMsgBox = [COLOR=#ff0000]scrObj.Eval[/COLOR]("MsgBox(""" & Prompt & """, " & Buttons & ", """ & Title & """, """ & HelpFile & """, " & Context & ")")
  End If
End Function

Sub Test_Msgbox()
 [COLOR=#0000cd] Dim Prompt As String, Title As String
  Dim Buttons As VbMsgBoxStyle[/COLOR]
  [COLOR=#0000cd]Prompt = ChrW(272) & "ây là MsgBox Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) _
          & "t!@Không l" & ChrW(7895) & "i Font Unicode ti" & ChrW(7871) & "ng Vi" _
          & ChrW(7879) & "t.@Có th" & ChrW(7875) & " t" & ChrW(7841) & "o ch" & _
          ChrW(7919) & " nét " & ChrW(273) & ChrW(7853) & "m."
    
  Title = "Msg Box Ti" & ChrW(7871) & "ng Vi" & ChrW(7879) & "t"
  Buttons = vbCritical + vbAbortRetryIgnore[/COLOR]
  [COLOR=#0000cd]VietUniMsgBox Prompt, Buttons, Title[/COLOR]
End Sub

Chỗ màu đỏ là thêm vào: Eval dùng để biến 1 chuỗi chứa câu lệnh thành lệnh thực thi (cái này tôi cũng có viết mấy bài trên GPE rồi).
Công dụng của Eval gần giống như Evaluate biến chuỗi chứa biểu thức toán học thành kết quả tính toán của biểu thức ấy
Chỗ màu xanh: Code của đồng chí viết "xấu" quá, sửa lại cho "đẹp"

Hình như nó chưa popup thì phải.

 

[ndu96081631]

Hình như nó chưa popup thì phải.

là sao hả bạn? Code ấy là MsgBox tiếng Việt Unicode thôi chứ popup gì đâu

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

là sao hả bạn? Code ấy là MsgBox tiếng Việt Unicode thôi chứ popup gì đâu

Ý em là nó khác với msgbox thường, msgbox thường thì khi hiện thông báo nó "nằm bên trên tất cả", không select được ở bảng tính.

 

[Kiều Mạnh]

là sao hả bạn? Code ấy là MsgBox tiếng Việt Unicode thôi chứ popup gì đâu

Nó hiện lên Cái Msgbox không giống giống trong Access

Mà nó giống Msgbox của CreateObject("Wscript.shell").PopUp và mấy Function API (Cạnh các nút Yes Hay No Vuông góc và không mượt)...

Còn trong Access nó hiện lên Cái Msgbox giao diện mượt hơn cạnh các nút Yes Hay No nó bo tròn đẹp hơn

Em cảm ơn Anh

 

[ndu96081631]

Nó hiện lên Cái Msgbox không giống giống trong Access

Mà nó giống Msgbox của CreateObject("Wscript.shell").PopUp và mấy Function API (Cạnh các nút Yes Hay No Vuông góc và không mượt)...

Còn trong Access nó hiện lên Cái Msgbox giao diện mượt hơn cạnh các nút Yes Hay No nó bo tròn đẹp hơn

Em cảm ơn Anh

Thế thì tôi không biết, có thể giao diện các control trong Access được thiết kế khác với Excel chăng?
Muốn "tròn" và "đẹp", tôi thường dùng DialogSheet
--------------------

Ý em là nó khác với msgbox thường, msgbox thường thì khi hiện thông báo nó "nằm bên trên tất cả", không select được ở bảng tính.

Thì chắc vậy rồi!
Tuy nhiên có thể sửa chỗ Buttons thành Buttons + 4096 ---> Sẽ cải thiện được đôi chút

 

[Excel Công Cụ Tuyệt Vời Của Bạn]

Thế thì tôi không biết, có thể giao diện các control trong Access được thiết kế khác với Excel chăng?
Muốn "tròn" và "đẹp", tôi thường dùng DialogSheet
--------------------

Thì chắc vậy rồi!
Tuy nhiên có thể sửa chỗ Buttons thành Buttons + 4096 ---> Sẽ cải thiện được đôi chút

Em thướng dùng DialogSheet, gõ tiếng Việt thoải mái, sử dụng "ngon"

 

[Hoàng Trọng Nghĩa]

Vào đây mà tải file và thưởng thức MsgBox Việt hóa nhé!

http://www.giaiphapexcel.com/forum/...a-bằng-Unicode-tuyệt-đẹp!&p=416372#post416372

Từ những hàm UniMsgBox sưu tầm, tôi đã cải tiến lại và gửi tặng các bạn.

Với cải tiến lần này, MsgBox thân thiện hơn, đẹp hơn, nút lệnh theo Application nên mượt mà hơn.

Có thể chọn Nút lệnh mặc định để khi Enter là chạy thủ tục tại nút đó

Đặc biệt, một phát hiện mới là có thể tô đậm dòng tiêu đề bên trong nội dung MsgBox

Và hơn thế nữa, đó chính là có thể Việt hóa tên nút lệnh một cách dễ dàng theo ý muốn của chúng ta!

Hàm chuyển đổi nút lệnh:

Private Function MsgBoxHookProc(ByVal lMsg As Long, _
                                ByVal wParam As Long, _
                                ByVal lParam As Long) As Long
                                
    If lMsg = HCBT_ACTIVATE Then
        [COLOR=#006400]'De biet Charcode, dung ham ASCW("KyTu")[/COLOR]
        StrOK = ChrW$(272) & ChrW$(7891) & "&ng " & ChrW$(253)     [COLOR=#006400]'Dong y[/COLOR]
        StrCancel = "&H" & ChrW$(7911) & "y b" & ChrW$(7887)       [COLOR=#006400]'Huy bo[/COLOR]
        StrAbort = "&H" & ChrW$(7911) & "y ngang"                  [COLOR=#006400] 'Huy ngang[/COLOR]
        StrRetry = "&Th" & ChrW$(7917) & " l" & ChrW$(7841) & "i"  [COLOR=#006400] 'Thu lai[/COLOR]
        StrIgnore = "&B" & ChrW$(7887) & " qua"                     [COLOR=#006400]'Bo qua[/COLOR]
        StrYes = "&Có"                                              [COLOR=#006400]'Co[/COLOR]
        StrNo = "&Không"                                           [COLOR=#006400]'Khong[/COLOR]
        StrYesAll = "Có &t" & ChrW$(7845) & "t c" & ChrW$(7843)     [COLOR=#006400]'Co tat ca[/COLOR]
        
        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

Hàm MyUniMsgBox:

Function MyUniMsgBox(ByVal msgTitle As String, _
                     Optional msgText As String, _
                     Optional msgButtonType As MsoAlertButtonType, _
                     Optional msgIconType As MsoAlertIconType, _
                     Optional msgDefaultType As MsoAlertDefaultType) As VbMsgBoxResult
[COLOR=#006400]   'Cau truc:
    'MyUniMsgBox TieuDe (bat buoc), NoiDung (bat buoc), [KieuNutLenh], [KieuIcon], [KieuNutLenhMacDinh][/COLOR]
    
    hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, 0, GetCurrentThreadId)
    
    On Error GoTo DefaultFirst
    MyUniMsgBox = Application.Assistant.DoAlert( _
                                        msgTitle, _
                                        msgText, _
                                        msgButtonType, _
                                        msgIconType, _
                                        msgDefaultType, _
                                        msoAlertCancelDefault, _
                                        False)
    Exit Function

DefaultFirst:
    On Error Resume Next
    MyUniMsgBox = Application.Assistant.DoAlert( _
                                        msgTitle, _
                                        msgText, _
                                        msgButtonType, _
                                        msgIconType, _
                                        msoAlertDefaultFirst, _
                                        msoAlertCancelDefault, _
                                        False)
End Function

Cách sử dụng:

        MyUniMsgBox TieuDe, NoiDung

        MyUniMsgBox TieuDe, NoiDung & .[B3], _
                            msoAlertButtonOK, _
                            msoAlertIconInfo, _
                            msoAlertDefaultFirst

        MyUniMsgBox TieuDe, NoiDung & .[B6], _
                            msoAlertButtonYesNoCancel, _
                            msoAlertIconQuery, _
                            msoAlertDefaultThird

        MyUniMsgBox TieuDe, NoiDung & .[B8], _
                            msoAlertButtonAbortRetryIgnore, _
                            msoAlertIconCritical, _
                            msoAlertDefaultSecond

        MyUniMsgBox TieuDe, NoiDung & .[B7], _
                            msoAlertButtonYesAllNoCancel, _
                            msoAlertIconWarning, _
                            msoAlertDefaultFourth

Các bạn sẽ thấy có quá nhiều thủ tục trong hàm, làm sao nhớ đây? Đơn giản thôi, các bạn chỉ cần nhớ cấu trúc:

MyUniMsgBox Tiêu đề (bắt buộc), [Nội dung], [Kiểu nút lệnh], [Kiểu Icon], [Kiểu nút lệnh mặc định]

Các kiểu trong dấu ngoặc móc là không bắt buộc, có hay không cũng không thành vấn đề, tùy theo kiểu thông báo mà các bạn thêm hoặc bớt.

Nhưng các bạn vẫn còn thắc mắc là trong cấu trúc có nhiều tiếng Anh khó nhớ quá, xin thưa là không có vấn đề gì, cứ sau khi đặt dấu phẩy sau Tiêu đề là nó sẽ hiển thị các List Constants cho các bạn lựa chọn!

Chúc các bạn có các thông báo thật Việt Nam!

 

[Kiều Mạnh]

Bài này nghĩa Viết biết lâu rồi ...Msgbox đó mượt và đẹp nhưng thấy code hoa cả mắt ngại xài thôi ....đang tìm kiếm cái tương tự code ngắn gọn dễ hiểu và sử dụng

 

[Kiều Mạnh]

Quậy Một hồi thấy Msgbox Nghĩa Viết hay thiệt ...lấy luôn cả ICON của Win

Sub VietHoa_Msgbox1()
    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

Code 2 Ngắn hơn Một Tẹo

Sub VietHoa_Msgbox2()
    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

 

[Truongan1996]

Mọi người cho em hỏi có cách nào làm cho chữ no Đậm lên trông cái thông báo Msgbox không vậy

 

[Công cụ tuyệt vời của bạn]

Mọi người cho em hỏi có cách nào làm cho chữ no Đậm lên trông cái thông báo Msgbox không vậy

Dùng Dialogsheet đi bạn