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

hands
29/06/2015
Excel Ứng Dụng

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 )

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

www.giaiphapexcel.com/diendan/threads/c%C3%A1ch-t%E1%BA%A1o-ti%C3%AAu-%C4%90%E1%BB%81-msgbox-l%C3%A0-ch%E1%BB%AF-%C4%90%E1%BA%ADm-ho%E1%BA%B7c-nghi%C3%AAng.105665/

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
https://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"

www.giaiphapexcel.com/diendan/threads/c%C3%A1ch-t%E1%BA%A1o-ti%C3%AAu-%C4%90%E1%BB%81-msgbox-l%C3%A0-ch%E1%BB%AF-%C4%90%E1%BA%ADm-ho%E1%BA%B7c-nghi%C3%AAng.105665/post-657261

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
https://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

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

Khóa học SprinGO phù hợp

Học Nhân sự Tổng hợp – Trở thành chiến binh nhân sự vững nghiệp vụ

Con người là một trong những yếu tố quan trọng của công ty, là tài sản quý giá của doanh nghiệp. Chính vì thế,...

Xem khóa học

Chia sẻ: