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

Liên hệ QC
Kiều Mạnh

Kiều Mạnh

I don't program, I beat code into submission!!!
Tham gia
9/6/12
Bài viết
5,421
Được thích
4,036
Giới tính
Nam
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
PHP: 
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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
kieu manh đã viết:
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
PHP: 
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
Nhấp chuột vào đây để mở rộng...

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é.
 
Upvote 0
quanghai1969 đã viết:
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é.
Nhấp chuột vào đây để mở rộng...
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
PHP: 
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
PHP: 
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
 
Upvote 0
kieu manh đã viết:
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
PHP: 
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
PHP: 
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
Nhấp chuột vào đây để mở rộng...
Viết vầy nè:
Mã: 
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
Mã: 
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"
 
Upvote 0
ndu96081631 đã viết:
Viết vầy nè:
Mã: 
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
Mã: 
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"
Nhấp chuột vào đây để mở rộng...
Hình như nó chưa popup thì phải.
 
Upvote 0
Upvote 0
ndu96081631 đã viết:
là sao hả bạn? Code ấy là MsgBox tiếng Việt Unicode thôi chứ popup gì đâu
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
kieu manh đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
--------------------
ExcelCongCuTuyetVoiCuaBan đã viết:
Ý 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.
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
ndu96081631 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Em thướng dùng DialogSheet, gõ tiếng Việt thoải mái, sử dụng "ngon"
 
Upvote 0
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

Hoàng Trọng Nghĩa đã viết:
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!

attachment.php


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

Mã: 
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:

Mã: 
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:

Mã: 
        MyUniMsgBox TieuDe, NoiDung
attachment.php


Mã: 
        MyUniMsgBox TieuDe, NoiDung & .[B3], _
                            msoAlertButtonOK, _
                            msoAlertIconInfo, _
                            msoAlertDefaultFirst
attachment.php


Mã: 
        MyUniMsgBox TieuDe, NoiDung & .[B6], _
                            msoAlertButtonYesNoCancel, _
                            msoAlertIconQuery, _
                            msoAlertDefaultThird
attachment.php


Mã: 
        MyUniMsgBox TieuDe, NoiDung & .[B8], _
                            msoAlertButtonAbortRetryIgnore, _
                            msoAlertIconCritical, _
                            msoAlertDefaultSecond
attachment.php


Mã: 
        MyUniMsgBox TieuDe, NoiDung & .[B7], _
                            msoAlertButtonYesAllNoCancel, _
                            msoAlertIconWarning, _
                            msoAlertDefaultFourth
attachment.php



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!

attachment.php


Chúc các bạn có các thông báo thật Việt Nam!
Nhấp chuột vào đây để mở rộng...
 
Upvote 0
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
 
Upvote 0
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
PHP: 
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
PHP: 
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
 
Lần chỉnh sửa cuối:
Upvote 0
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
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
  • Question
Em muốn sau 30 giây thì checkbox tự tắt (tự bỏ dấu check)
Trả lời
17
Đọc
328
VetMini
V
H
GĐ- Về tính tổng của hàng và cột có điều kiện
Trả lời
2
Đọc
49
VetMini
V
C
minh quan tam bang cost breakdown- nhờ các chuyên gia chỉ dạy
    • Buồn
Trả lời
1
Đọc
17
VetMini
V
xuannguyet968
xin các cao nhận giúp mình với
    • Phẫn nộ
Trả lời
7
Đọc
139
VetMini
V
N
  • Question
Cố định các controls trong UserForm, giống như cách cố định dòng cột trên sheet?
Trả lời
11
Đọc
181
Nguyễn Khả Nam
N
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom