Hàm Chuyển Mã Tiếng Việt, Msgbox Tiếng Việt

Trang chủ » Msgbox Tiếng Việt Vba » Hàm Chuyển Mã Tiếng Việt, Msgbox Tiếng Việt

Có thể bạn quan tâm

  • TIN MỚI
    • Kiến thức hay
    • Tin Công nghệ
    • Đánh giá công nghệ
    • Tiền của tôi
    • Số hóa
    • Tin Giáo dục
    • Tin Giải trí
    • Ngữ pháp tiếng anh
    • Kinh nghiệm học tiếng anh
    • Xem Phim
    • Kinh nghiệm
  • KHÓA HỌC CỦA BẠN
  • Tin học văn phòng
    • Khóa học Tuyệt đỉnh Power BI
    • Khóa học lập trình VBA Excel
    • Khóa dựng phần mềm quản lý bằng MS ACCESS
    • Đào tạo Excel 2010 chuyên nghiệp
    • Đào tạo Word 2010 chuyên nghiệp
    • Đào tạo Powerpoint 2010 Pro
    • Đào tạo vẽ Visio 2010 chuyên nghiệp
    • Chứng chỉ MOS
  • Ebook
  • Kỹ Năng Mềm
    • Học Excel
    • Thủ thuật Excel
    • Excel nâng cao
    • Excel VBA
    • Google Sheets
    • Học Word
    • Học PowerPoint
    • Học Access
  • Review Công nghệ
    • Đọc báo Song ngữ Anh- Việt
    • Tải Phần mềm
    • Hacker
    • Giải trí
    • Học tiếng anh
  • Lập trình
    • Đào tạo lập trình Foxpro
    • Đào tạo lập trình ACCESS 2010
    • Đào tạo Lập trình Excel
    • Lập trình Web
    • Đào tạo Lập trình PHP
    • Đào tạo lập trình Mobile
  • Tin công nghệ
    • Tin Bảo mật - An toàn thông tin
    • Giáo dục 4.0
  • Học đồ họa
    • Đào tạo photoshop chuyên nghiệp
    • Đào tạo CorelDraw chuyên nghiệp
  • Office
    • Đào tạo Excel 2013 của Microsoft
    • Đào tạo Word 2013 của Microsoft
    • Đào tạo Powerpoint 2013
    • Các chương trình khác
  • Học Online
    • Hướng dẫn Tiếng anh
    • Thực hành Tiếng anh chuẩn quốc tế
    • Thư viện khóa học
    • Thực hành Tiếng anh giao tiếp
    • Bài giảng điện tử
  • Công cụ hữu ích
    • Đọc số thành chữ
    • Tra cứu phím tắt Excel
    • Đọc công thức Excel Dễ hơn
    • Đếm số từ trong Văn bản
    • Đếm số ký tự trong Văn bản
    • Chuyển Văn bản thành Mp3
    • Tạo QrCode
    • Bộ soạn thảo trực tuyến
    • Bộ công cụ đặc biệt
    • Diễn đàn
  • Phiên âm chuẩn
  • SMS Free
  • HỌ ĐINH
Home » Công nghệ mới » Quản trị cơ sở dữ liệu SQL » Hàm chuyển mã tiếng Việt, Msgbox tiếng Việt Hàm chuyển mã tiếng Việt, Msgbox tiếng Việt

Học viện đào tạo trực tuyến Chủ Nhật, 1 tháng 2, 2015 0 No comments

Một trong những vấn đề được nhiều bạn quan tâm, đó là LÀM SAO ĐỂ HIỆN THÔNG BÁO TIẾNG VIỆT Hàm chuyển mã từ TCVN 3 sang UNICODETác giả: BinhOverAC Www.GiaiPhapExcel.com

Function TCVN3toUNICODE(vnstr As String) Dim c As String, i As Integer For i = 1 To Len(vnstr) c = Mid(vnstr, i, 1) Select Case c Case "a": c = ChrW$(97) Case "¸": c = ChrW$(225) Case "µ": c = ChrW$(224) Case "¶": c = ChrW$(7843) Case "·": c = ChrW$(227) Case "¹": c = ChrW$(7841) Case "¨": c = ChrW$(259) Case "¾": c = ChrW$(7855) Case "»": c = ChrW$(7857) Case "¼": c = ChrW$(7859) Case "½": c = ChrW$(7861) Case "Æ": c = ChrW$(7863) Case "©": c = ChrW$(226) Case "Ê": c = ChrW$(7845) Case "Ç": c = ChrW$(7847) Case "È": c = ChrW$(7849) Case "É": c = ChrW$(7851) Case "Ë": c = ChrW$(7853) Case "e": c = ChrW$(101) Case "Ð": c = ChrW$(233) Case "Ì": c = ChrW$(232) Case "Î": c = ChrW$(7867) Case "Ï": c = ChrW$(7869) Case "Ñ": c = ChrW$(7865) Case "ª": c = ChrW$(234) Case "Õ": c = ChrW$(7871) Case "Ò": c = ChrW$(7873) Case "Ó": c = ChrW$(7875) Case "Ô": c = ChrW$(7877) Case "Ö": c = ChrW$(7879) Case "o": c = ChrW$(111) Case "ã": c = ChrW$(243) Case "ß": c = ChrW$(242) Case "á": c = ChrW$(7887) Case "â": c = ChrW$(245) Case "ä": c = ChrW$(7885) Case "«": c = ChrW$(244) Case "è": c = ChrW$(7889) Case "å": c = ChrW$(7891) Case "æ": c = ChrW$(7893) Case "ç": c = ChrW$(7895) Case "é": c = ChrW$(7897) Case "¬": c = ChrW$(417) Case "í": c = ChrW$(7899) Case "ê": c = ChrW$(7901) Case "ë": c = ChrW$(7903) Case "ì": c = ChrW$(7905) Case "î": c = ChrW$(7907) Case "i": c = ChrW$(105) Case "Ý": c = ChrW$(237) Case "×": c = ChrW$(236) Case "Ø": c = ChrW$(7881) Case "Ü": c = ChrW$(297) Case "Þ": c = ChrW$(7883) Case "u": c = ChrW$(117) Case "ó": c = ChrW$(250) Case "ï": c = ChrW$(249) Case "ñ": c = ChrW$(7911) Case "ò": c = ChrW$(361) Case "ô": c = ChrW$(7909) Case "­": c = ChrW$(432) Case "ø": c = ChrW$(7913) Case "õ": c = ChrW$(7915) Case "ö": c = ChrW$(7917) Case "÷": c = ChrW$(7919) Case "ù": c = ChrW$(7921) Case "y": c = ChrW$(121) Case "ý": c = ChrW$(253) Case "ú": c = ChrW$(7923) Case "û": c = ChrW$(7927) Case "ü": c = ChrW$(7929) Case "þ": c = ChrW$(7925) Case "®": c = ChrW$(273) Case "A": c = ChrW$(65) Case "¡": c = ChrW$(258) Case "¢": c = ChrW$(194) Case "E": c = ChrW$(69) Case "£": c = ChrW$(202) Case "O": c = ChrW$(79) Case "¤": c = ChrW$(212) Case "¥": c = ChrW$(416) Case "I": c = ChrW$(73) Case "U": c = ChrW$(85) Case "¦": c = ChrW$(431) Case "Y": c = ChrW$(89) Case "§": c = ChrW$(272) End Select TCVN3toUNICODE = TCVN3toUNICODE + c Next i End Function
Hàm chuyển mã từ VNI sang UNICODE[/code]Tác giả: BinhOverAC Www.GiaiPhapExcel.com
Function VNItoUNICODE(vnstr As String) Dim c As String, i As Integer Dim db As Boolean For i = 1 To Len(vnstr) db = False If i < Len(vnstr) Then c = Mid(vnstr, i + 1, 1) If c = "ù" Or c = "ø" Or c = "û" Or c = "õ" Or c = "ï" Or c = "ê" Or c = "é" Or c = "è" Or c = "ú" Or c = "ü" Or c = "ë" Or c = "â" Or c = "á" Or c = "à" Or c = "å" Or c = "ã" Or c = "ä" Or c = "Ù" Or c = "Ø" Or c = "Û" Or c = "Õ" Or c = "Ï" Or c = "Ê" Or c = "É" Or c = "È" Or c = "Ú" Or c = "Ü" Or c = "Ë" Or c = "Â" End If If db Then c = Mid(vnstr, i, 2) Select Case c Case "aù": c = ChrW$(225) Case "aø": c = ChrW$(224) Case "aû": c = ChrW$(7843) Case "aõ": c = ChrW$(227) Case "aï": c = ChrW$(7841) Case "aê": c = ChrW$(259) Case "aé": c = ChrW$(7855) Case "aè": c = ChrW$(7857) Case "aú": c = ChrW$(7859) Case "aü": c = ChrW$(7861) Case "aë": c = ChrW$(7863) Case "aâ": c = ChrW$(226) Case "aá": c = ChrW$(7845) Case "aà": c = ChrW$(7847) Case "aå": c = ChrW$(7849) Case "aã": c = ChrW$(7851) Case "aä": c = ChrW$(7853) Case "eù": c = ChrW$(233) Case "eø": c = ChrW$(232) Case "eû": c = ChrW$(7867) Case "eõ": c = ChrW$(7869) Case "eï": c = ChrW$(7865) Case "eâ": c = ChrW$(234) Case "eá": c = ChrW$(7871) Case "eà": c = ChrW$(7873) Case "eå": c = ChrW$(7875) Case "eã": c = ChrW$(7877) Case "eä": c = ChrW$(7879) Case "où": c = ChrW$(243) Case "oø": c = ChrW$(242) Case "oû": c = ChrW$(7887) Case "oõ": c = ChrW$(245) Case "oï": c = ChrW$(7885) Case "oâ": c = ChrW$(244) Case "oá": c = ChrW$(7889) Case "oà": c = ChrW$(7891) Case "oå": c = ChrW$(7893) Case "oã": c = ChrW$(7895) Case "oä": c = ChrW$(7897) Case "ôù": c = ChrW$(7899) Case "ôø": c = ChrW$(7901) Case "ôû": c = ChrW$(7903) Case "ôõ": c = ChrW$(7905) Case "ôï": c = ChrW$(7907) Case "uù": c = ChrW$(250) Case "uø": c = ChrW$(249) Case "uû": c = ChrW$(7911) Case "uõ": c = ChrW$(361) Case "uï": c = ChrW$(7909) Case "öù": c = ChrW$(7913) Case "öø": c = ChrW$(7915) Case "öû": c = ChrW$(7917) Case "öõ": c = ChrW$(7919) Case "öï": c = ChrW$(7921) Case "yù": c = ChrW$(253) Case "yø": c = ChrW$(7923) Case "yû": c = ChrW$(7927) Case "yõ": c = ChrW$(7929) Case "AÙ": c = ChrW$(193) Case "AØ": c = ChrW$(192) Case "AÛ": c = ChrW$(7842) Case "AÕ": c = ChrW$(195) Case "AÏ": c = ChrW$(7840) Case "AÊ": c = ChrW$(258) Case "AÉ": c = ChrW$(7854) Case "AÈ": c = ChrW$(7856) Case "AÚ": c = ChrW$(7858) Case "AÜ": c = ChrW$(7860) Case "AË": c = ChrW$(7862) Case "AÂ": c = ChrW$(194) Case "AÁ": c = ChrW$(7844) Case "AÀ": c = ChrW$(7846) Case "AÅ": c = ChrW$(7848) Case "AÃ": c = ChrW$(7850) Case "AÄ": c = ChrW$(7852) Case "EÙ": c = ChrW$(201) Case "EØ": c = ChrW$(200) Case "EÛ": c = ChrW$(7866) Case "EÕ": c = ChrW$(7868) Case "EÏ": c = ChrW$(7864) Case "EÂ": c = ChrW$(202) Case "EÁ": c = ChrW$(7870) Case "EÀ": c = ChrW$(7872) Case "EÅ": c = ChrW$(7874) Case "EÃ": c = ChrW$(7876) Case "EÄ": c = ChrW$(7878) Case "OÙ": c = ChrW$(211) Case "OØ": c = ChrW$(210) Case "OÛ": c = ChrW$(7886) Case "OÕ": c = ChrW$(213) Case "OÏ": c = ChrW$(7884) Case "OÂ": c = ChrW$(212) Case "OÁ": c = ChrW$(7888) Case "OÀ": c = ChrW$(7890) Case "OÅ": c = ChrW$(7892) Case "OÃ": c = ChrW$(7894) Case "OÄ": c = ChrW$(7896) Case "ÔÙ": c = ChrW$(7898) Case "ÔØ": c = ChrW$(7900) Case "ÔÛ": c = ChrW$(7902) Case "ÔÕ": c = ChrW$(7904) Case "ÔÏ": c = ChrW$(7906) Case "UÙ": c = ChrW$(218) Case "UØ": c = ChrW$(217) Case "UÛ": c = ChrW$(7910) Case "UÕ": c = ChrW$(360) Case "UÏ": c = ChrW$(7908) Case "ÖÙ": c = ChrW$(7912) Case "ÖØ": c = ChrW$(7914) Case "ÖÛ": c = ChrW$(7916) Case "ÖÕ": c = ChrW$(7918) Case "ÖÏ": c = ChrW$(7920) Case "YÙ": c = ChrW$(221) Case "YØ": c = ChrW$(7922) Case "YÛ": c = ChrW$(7926) Case "YÕ": c = ChrW$(7928) End Select Else c = Mid(vnstr, i, 1) Select Case c Case "ô": c = ChrW$(417) Case "í": c = ChrW$(237) Case "ì": c = ChrW$(236) Case "æ": c = ChrW$(7881) Case "ó": c = ChrW$(297) Case "ò": c = ChrW$(7883) Case "ö": c = ChrW$(432) Case "î": c = ChrW$(7925) Case "ñ": c = ChrW$(273) Case "Ô": c = ChrW$(416) Case "Í": c = ChrW$(205) Case "Ì": c = ChrW$(204) Case "Æ": c = ChrW$(7880) Case "Ó": c = ChrW$(296) Case "Ò": c = ChrW$(7882) Case "Ö": c = ChrW$(431) Case "Î": c = ChrW$(7924) Case "Ñ": c = ChrW$(272) End Select End If VNItoUNICODE = VNItoUNICODE + c If db Then i = i + 1 Next i End Function
Hàm chuyển từ UNICODE sang VNI
Function UNICODEtoVNI(ByVal vnstr As String) Dim c As String, i As Integer For i = 1 To Len(vnstr) c = Mid(vnstr, i, 1) Select Case c Case ChrW$(97): c = "a" Case ChrW$(225): c = "aù" Case ChrW$(224): c = "aø" Case ChrW$(7843): c = "aû" Case ChrW$(227): c = "aõ" Case ChrW$(7841): c = "aï" Case ChrW$(259): c = "aê" Case ChrW$(7855): c = "aé" Case ChrW$(7857): c = "aè" Case ChrW$(7859): c = "aú" Case ChrW$(7861): c = "aü" Case ChrW$(7863): c = "aë" Case ChrW$(226): c = "aâ" Case ChrW$(7845): c = "aá" Case ChrW$(7847): c = "aà" Case ChrW$(7849): c = "aå" Case ChrW$(7851): c = "aã" Case ChrW$(7853): c = "aä" Case ChrW$(101): c = "e" Case ChrW$(233): c = "eù" Case ChrW$(232): c = "eø" Case ChrW$(7867): c = "eû" Case ChrW$(7869): c = "eõ" Case ChrW$(7865): c = "eï" Case ChrW$(234): c = "eâ" Case ChrW$(7871): c = "eá" Case ChrW$(7873): c = "eà" Case ChrW$(7875): c = "eå" Case ChrW$(7877): c = "eã" Case ChrW$(7879): c = "eä" Case ChrW$(111): c = "o" Case ChrW$(243): c = "où" Case ChrW$(242): c = "oø" Case ChrW$(7887): c = "oû" Case ChrW$(245): c = "oõ" Case ChrW$(7885): c = "oï" Case ChrW$(244): c = "oâ" Case ChrW$(7889): c = "oá" Case ChrW$(7891): c = "oà" Case ChrW$(7893): c = "oå" Case ChrW$(7895): c = "oã" Case ChrW$(7897): c = "oä" Case ChrW$(417): c = "ô" Case ChrW$(7899): c = "ôù" Case ChrW$(7901): c = "ôø" Case ChrW$(7903): c = "ôû" Case ChrW$(7905): c = "ôõ" Case ChrW$(7907): c = "ôï" Case ChrW$(105): c = "i" Case ChrW$(237): c = "í" Case ChrW$(236): c = "ì" Case ChrW$(7881): c = "æ" Case ChrW$(297): c = "ó" Case ChrW$(7883): c = "ò" Case ChrW$(117): c = "u" Case ChrW$(250): c = "uù" Case ChrW$(249): c = "uø" Case ChrW$(7911): c = "uû" Case ChrW$(361): c = "uõ" Case ChrW$(7909): c = "uï" Case ChrW$(432): c = "ö" Case ChrW$(7913): c = "öù" Case ChrW$(7915): c = "uø" Case ChrW$(7917): c = "öû" Case ChrW$(7919): c = "öõ" Case ChrW$(7921): c = "öï" Case ChrW$(121): c = "y" Case ChrW$(253): c = "yù" Case ChrW$(7923): c = "yø" Case ChrW$(7927): c = "yû" Case ChrW$(7929): c = "yõ" Case ChrW$(7925): c = "î" Case ChrW$(273): c = "ñ" Case ChrW$(65): c = "A" Case ChrW$(193): c = "AÙ" Case ChrW$(192): c = "AØ" Case ChrW$(7842): c = "AÛ" Case ChrW$(195): c = "AÕ" Case ChrW$(7840): c = "AÏ" Case ChrW$(258): c = "AÊ" Case ChrW$(7854): c = "AÉ" Case ChrW$(7856): c = "AÈ" Case ChrW$(7858): c = "AÚ" Case ChrW$(7860): c = "AÜ" Case ChrW$(7862): c = "AË" Case ChrW$(194): c = "AÂ" Case ChrW$(7844): c = "AÁ" Case ChrW$(7846): c = "AÀ" Case ChrW$(7848): c = "AÅ" Case ChrW$(7850): c = "AÃ" Case ChrW$(7852): c = "AÄ" Case ChrW$(69): c = "E" Case ChrW$(201): c = "EÙ" Case ChrW$(200): c = "EØ" Case ChrW$(7866): c = "EÛ" Case ChrW$(7868): c = "EÕ" Case ChrW$(7864): c = "EÏ" Case ChrW$(202): c = "EÂ" Case ChrW$(7870): c = "EÁ" Case ChrW$(7872): c = "EÀ" Case ChrW$(7874): c = "EÅ" Case ChrW$(7876): c = "EÃ" Case ChrW$(7878): c = "EÄ" Case ChrW$(79): c = "O" Case ChrW$(211): c = "OÙ" Case ChrW$(210): c = "OØ" Case ChrW$(7886): c = "OÛ" Case ChrW$(213): c = "OÕ" Case ChrW$(7884): c = "OÏ" Case ChrW$(212): c = "OÂ" Case ChrW$(7888): c = "OÁ" Case ChrW$(7890): c = "OÀ" Case ChrW$(7892): c = "OÅ" Case ChrW$(7894): c = "OÃ" Case ChrW$(7896): c = "OÄ" Case ChrW$(416): c = "Ô" Case ChrW$(7898): c = "ÔÙ" Case ChrW$(7900): c = "ÔØ" Case ChrW$(7902): c = "ÔÛ" Case ChrW$(7904): c = "ÔÕ" Case ChrW$(7906): c = "ÔÏ" Case ChrW$(73): c = "I" Case ChrW$(205): c = "Í" Case ChrW$(204): c = "Ì" Case ChrW$(7880): c = "Æ" Case ChrW$(296): c = "Ó" Case ChrW$(7882): c = "Ò" Case ChrW$(85): c = "U" Case ChrW$(218): c = "UÙ" Case ChrW$(217): c = "UØ" Case ChrW$(7910): c = "UÛ" Case ChrW$(360): c = "UÕ" Case ChrW$(7908): c = "UÏ" Case ChrW$(431): c = "Ö" Case ChrW$(7912): c = "ÖÙ" Case ChrW$(7914): c = "ÖØ" Case ChrW$(7916): c = "ÖÛ" Case ChrW$(7918): c = "ÖÕ" Case ChrW$(7920): c = "ÖÏ" Case ChrW$(89): c = "Y" Case ChrW$(221): c = "YÙ" Case ChrW$(7922): c = "YØ" Case ChrW$(7926): c = "YÛ" Case ChrW$(7928): c = "YÕ" Case ChrW$(7924): c = "Î" Case ChrW$(272): c = "Ñ" End Select UNICODEtoVNI = UNICODEtoVNI + c Next i End Function
Để thông báo hiện được tiếng việt chúng ta dùng hai hàm API sau. Đầu tiên chúng ta phải khai báo trong module:'Khai báo các hàm API trong thư viện User32.DLL
Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
Sau đó chúng ta viết lại hàm Msgbox để hiện thông báo với chuổi Unicode như sau:
Function MsgBoxUni(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant = vbNullString) As VbMsgBoxResult 'Function MsgBoxUni(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant, Optional HelpFile, Optional Context) As VbMsgBoxResult 'BStrMsg,BStrTitle : La chuoi Unicode Dim BStrMsg, BStrTitle 'Hàm StrConv Chuyen chuoi ve ma Unicode BStrMsg = StrConv(PromptUni, vbUnicode) BStrTitle = StrConv(TitleUni, vbUnicode) MsgBoxUni = MessageBoxW(GetActiveWindow, BStrMsg, BStrTitle, Buttons) End Function
Ở đây các bạn cần chú ý:Trong màn hình sọan thảo code VBE (Visual Basic Editor) các bạn phải biết chỉnh bộ gõ, trước khi nhập nội dung cho hàm hiển thị.Ví dụ: tôi muốn hàm hiển thỉ thông báo Bạn đã thành công (font VNI) tôi sẽ thực hiện như sauĐầu tiên tôi chỉnh bộ gõ theo kiểu gõ là Telex, bảng mã là VNI WindowsTôi sẽ sử dụng hàm MsgboxUni như sau:
Sub HienThongBaoTV() 'Tôi dùng hàm VNItoUnicode ?e^? chuye^?n mã VNI sang Unicode 'Các ba.n chú ý khi ba('t ?a^`u nha^.p vào no^.i dung thì hãy ba^.t che^' ?o^. gõ tie^'ng vie^.t MsgBoxUni VNI("Coäng hoaø xaõ hoäi chuû nghóa Vieät Nam") End Sub
Trong Visual Basic chúng ta có thể dùng hàm sau, để thay thế hàm Msgbox nhằm thể hiện chuổi Unicode
Function MsgBox(ByVal PromptUni As Variant, Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, Optional ByVal TitleUni As Variant = vbNullString) As VbMsgBoxResult Dim BStrMsg, BStrTitle BStrMsg = StrConv(PromptUni, vbUnicode) BStrTitle = StrConv(TitleUni, vbUnicode) MsgBox = MessageBoxW(GetActiveWindow, BStrMsg, BStrTitle, Buttons) End Function
Các bạn có thể tham khảo tại đây:VovisoftCác hàm cho Unicode chữ ViệtDưới đây là danh sách của một Sub và 13 hàm (Functions) dùng để xử lý Unicode chữ Việt. Ðể hiểu thêm về Unicode và nhất là cách hoán chuyển giữa UTF-16 và UTF-8 xin đọc bài Căn bản Unicode cho VB6 Programers cũng trên trang Vovisoft.
Sub InitUnicode()Initialise String chứa các Unicode Vowels v đ, Ð
Function IsUniChar(Ch) As BooleanKết quả True nếu Ch l Unicode character
Function IsUpperUniChar(Ch) As BooleanKết quả True nếu Ch l Unicode character chữ Hoa
Function UpperUniChar(Ch) As StringBiến Unicode character Ch th nh chữ Hoa
Function LowerUniChar(Ch) As StringBiến Unicode character Ch th nh chữ Thường
Function UpperUniStr(IPString) As StringBiến cả Unicode String IPString th nh chữ Hoa
Function LowerUniStr(IPString) As StringBiến cả Unicode String IPString th nh chữ Thường
Function ToUTF8(ByVal UTF16 As Long) As Byte()Hoán chuyển UTF-16 ra 2 hay 3 bytes UTF-8
Function ToUTF16(BArray) As LongHoán chuyển 2 hay 3 bytes UTF-8 ra UTF-16
Function UniStrToUTF8(UniString) As Byte()Hoán chuyển Unicode String ra UTF-8 bytes
Function UTF8ToUniStr(BArray) As StringHoán chuyển UTF-8 bytes ra Unicode String
Function HexDisplayOfFile(TFileName) As StringHiển thị Text của một file trong dạng Hex
Function GetFileEncoding(TFileName) As coEncodingLấy loại Encoding của Text file: ANSI, Unicode hay UTF-8
Function ToUniDecimal(UniString As String) As StringXuất khẩu Unicode String ra dạng ✏ để dùng cho Web
Option Explicit Public UVowels As String ' API to access VB6 String by pointer in order to copy memory Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpvDest As Any, lpvSource As Any, ByVal cbCopy As Long) Enum coEncoding coANSI = 0 coUnicode = 1 coUTF8 = 2 End Enum Sub InitUnicode() Dim TStr As String ' Initialise the list of Unicode Vowels, 67 lowerCase followed by 67 Uppercase ' Note that by using the Function chrW, the &HE1 Unicode character is stored internally ' as &HE100 for a String character TStr = TStr & ChrW(&HE1) & ChrW(&HE0) & ChrW(&H1EA3) & ChrW(&HE3) & ChrW(&H1EA1) & ChrW(&H103) & ChrW(&H1EAF) & ChrW(&H1EB1) & ChrW(&H1EB3) & ChrW(&H1EB5) & ChrW(&H1EB7) & ChrW(&HE2) & ChrW(&H1EA5) & ChrW(&H1EA7) & ChrW(&H1EA9) & ChrW(&H1EAB) & ChrW(&H1EAD) & ChrW(&HE9) & ChrW(&HE8) & ChrW(&H1EBB) TStr = TStr & ChrW(&H1EBD) & ChrW(&H1EB9) & ChrW(&HEA) & ChrW(&H1EBF) & ChrW(&H1EC1) & ChrW(&H1EC3) & ChrW(&H1EC5) & ChrW(&H1EC7) & ChrW(&HED) & ChrW(&HEC) & ChrW(&H1EC9) & ChrW(&H129) & ChrW(&H1ECB) & ChrW(&HF3) & ChrW(&HF2) & ChrW(&H1ECF) & ChrW(&HF5) & ChrW(&H1ECD) & ChrW(&HF4) & ChrW(&H1ED1) TStr = TStr & ChrW(&H1ED3) & ChrW(&H1ED5) & ChrW(&H1ED7) & ChrW(&H1ED9) & ChrW(&H1A1) & ChrW(&H1EDB) & ChrW(&H1EDD) & ChrW(&H1EDF) & ChrW(&H1EE1) & ChrW(&H1EE3) & ChrW(&HFA) & ChrW(&HF9) & ChrW(&H1EE7) & ChrW(&H169) & ChrW(&H1EE5) & ChrW(&H1B0) & ChrW(&H1EE9) & ChrW(&H1EEB) & ChrW(&H1EED) & ChrW(&H1EEF) TStr = TStr & ChrW(&H1EF1) & ChrW(&HFD) & ChrW(&H1EF3) & ChrW(&H1EF7) & ChrW(&H1EF9) & ChrW(&H1EF5) & ChrW(&H111) & ChrW(&HC1) & ChrW(&HC0) & ChrW(&H1EA2) & ChrW(&HC3) & ChrW(&H1EA0) & ChrW(&H102) & ChrW(&H1EAE) & ChrW(&H1EB0) & ChrW(&H1EB2) & ChrW(&H1EB4) & ChrW(&H1EB6) & ChrW(&HC2) & ChrW(&H1EA4) TStr = TStr & ChrW(&H1EA6) & ChrW(&H1EA8) & ChrW(&H1EAA) & ChrW(&H1EAC) & ChrW(&HC9) & ChrW(&HC8) & ChrW(&H1EBA) & ChrW(&H1EBC) & ChrW(&H1EB8) & ChrW(&HCA) & ChrW(&H1EBE) & ChrW(&H1EC0) & ChrW(&H1EC2) & ChrW(&H1EC4) & ChrW(&H1EC6) & ChrW(&HCD) & ChrW(&HCC) & ChrW(&H1EC8) & ChrW(&H128) & ChrW(&H1ECA) TStr = TStr & ChrW(&HD3) & ChrW(&HD2) & ChrW(&H1ECE) & ChrW(&HD5) & ChrW(&H1ECC) & ChrW(&HD4) & ChrW(&H1ED0) & ChrW(&H1ED2) & ChrW(&H1ED4) & ChrW(&H1ED6) & ChrW(&H1ED8) & ChrW(&H1A0) & ChrW(&H1EDA) & ChrW(&H1EDC) & ChrW(&H1EDE) & ChrW(&H1EE0) & ChrW(&H1EE2) & ChrW(&HDA) & ChrW(&HD9) & ChrW(&H1EE6) TStr = TStr & ChrW(&H168) & ChrW(&H1EE4) & ChrW(&H1AF) & ChrW(&H1EE8) & ChrW(&H1EEA) & ChrW(&H1EEC) & ChrW(&H1EEE) & ChrW(&H1EF0) & ChrW(&HDD) & ChrW(&H1EF2) & ChrW(&H1EF6) & ChrW(&H1EF8) & ChrW(&H1EF4) & ChrW(&H110) UVowels = TStr ' Assign to the Unicode Vowel list End Sub Function IsUniChar(Ch) As Boolean ' Return True if Ch is a Unicode Vowel or dd, DD IsUniChar = (InStr(UVowels, Ch) > 0) End Function Function IsUpperUniChar(Ch) As Boolean ' Return True if Ch is an Uppercase Unicode Vowel or DD IsUpperUniChar = (InStr(UVowels, Ch) > 67) End Function Function UpperUniChar(Ch) As String ' Return the Uppercase for a given vowel or dd Dim Pos ' Position of character in Unicode vowel list ' Locate the character in list of Unicode vowels Pos = InStr(UVowels, Ch) If (Pos > 67) Then UpperUniChar = Ch ' It's already uppercase - leave it alone ElseIf (Pos > 0) Then ' It's a Lowercase Unicode Vowel - so get the corresponding Uppercase vowel in the list UpperUniChar = Mid(UVowels, Pos + 67, 1) Else ' It's just a normal ANSI character UpperUniChar = UCase(Ch) End If End Function Function LowerUniChar(Ch) As String ' Return the Lowercase for a given vowel or DD Dim Pos ' Position of character in Unicode vowel list ' Locate the character in list of Unicode vowels Pos = InStr(UVowels, Ch) If Pos > 67 Then ' It's an Uppercase Unicode Vowel - so get the corresponding Lowercase vowel in the list LowerUniChar = Mid(UVowels, Pos - 67, 1) ElseIf Pos > 0 Then LowerUniChar = Ch ' It's already Lowercase - leave it alone Else ' It's just a normal ANSI character LowerUniChar = LCase(Ch) End If End Function Function UpperUniStr(IPString) As String ' Convert a Unicode string to UpperCase Dim i, TLen, TStr TStr = "" ' Initialise the resultant string TLen = Len(IPString) ' get length of input Unicode string If TLen > 0 Then ' Iterate through each character of the Unicode string For i = 1 To TLen ' Convert each character to uppercase TStr = TStr & UpperUniChar(Mid(IPString, i, 1)) Next End If UpperUniStr = TStr ' Return the resultant string End Function Function LowerUniStr(IPString) As String ' Convert a Unicode string to LowerCase Dim i, TLen, TStr TStr = "" ' Initialise the resultant string TLen = Len(IPString) ' get length of input Unicode string If TLen > 0 Then ' Iterate through each character of the Unicode string For i = 1 To TLen ' Convert each character to lowercase TStr = TStr & LowerUniChar(Mid(IPString, i, 1)) Next End If LowerUniStr = TStr ' Return the resultant string End Function Function ToUTF8(ByVal UTF16 As Long) As Byte() ' Convert a 16bit UTF-16BE to 2 or 3 UTF-8 bytes Dim BArray() As Byte If UTF16 < &H80 Then ReDim BArray(0) ' one byte UTF-8 BArray(0) = UTF16 ' Use number as is ElseIf UTF16 < &H800 Then ReDim BArray(1) ' two byte UTF-8 BArray(1) = &H80 + (UTF16 And &H3F) ' Least Significant 6 bits UTF16 = UTF16 \ &H40 ' Shift UTF16 number right 6 bits BArray(0) = &HC0 + (UTF16 And &H1F) ' Use 5 remaining bits Else ReDim BArray(2) ' three byte UTF-8 BArray(2) = &H80 + (UTF16 And &H3F) ' Least Significant 6 bits UTF16 = UTF16 \ &H40 ' Shift UTF16 number right 6 bits BArray(1) = &H80 + (UTF16 And &H3F) ' Use next 6 bits UTF16 = UTF16 \ &H40 ' Shift UTF16 number right 6 bits again BArray(0) = &HE0 + (UTF16 And &HF) ' Use 4 remaining bits End If ToUTF8 = BArray ' Return UTF-8 bytes in an array End Function Function ToUTF16(BArray) As Long ' Convert 2 or 3 UTF-8 bytes to a 16bit UTF-16BE Dim IntUB IntUB = UBound(BArray) ' Find out how many bytes UTF-8 takes Select Case IntUB Case 0 ' one byte UTF-8. Note that bArray starts with index=0 ToUTF16 = BArray(0) ' Use number as is Case 1 ' two byte UTF-8 ToUTF16 = (BArray(0) And &H1F) * &H40 + (BArray(1) And &H3F) Case 2 ' three byte UTF-8 ToUTF16 = (BArray(0) And &HF) * &H1000 + (BArray(1) And &H3F) * &H40 + (BArray(2) And &H3F) End Select End Function Function UniStrToUTF8(UniString) As Byte() ' Convert a Unicode string to a byte stream of UTF-8 Dim BArray() As Byte Dim TempB() As Byte Dim i As Long Dim k As Long Dim TLen As Long Dim b1 As Byte Dim b2 As Byte Dim UTF16 As Long Dim j TLen = Len(UniString) ' Obtain length of Unicode input string If TLen = 0 Then Exit Function ' get out if there's nothing to convert k = 0 For i = 1 To TLen ' Work out the UTF16 value of the Unicode character CopyMemory b1, ByVal StrPtr(UniString) + ((i - 1) * 2), 1 CopyMemory b2, ByVal StrPtr(UniString) + ((i - 1) * 2) + 1, 1 ' Combine the 2 bytes into the Unicode UTF-16 UTF16 = b2 ' assign b2 to UTF16 before multiplying by 256 to avoid overflow UTF16 = UTF16 * 256 + b1 ' Convert UTF-16 to 2 or 3 bytes of UTF-8 TempB = ToUTF8(UTF16) ' Copy the resultant bytes to BArray For j = 0 To UBound(TempB) ReDim Preserve BArray(k) BArray(k) = TempB(j): k = k + 1 Next ReDim TempB(0) Next UniStrToUTF8 = BArray ' Return the resultant UTF-8 byte array End Function Function UTF8ToUniStr(BArray) As String ' Convert a byte stream of UTF-8 to Unicode String Dim i As Long Dim TopIndex As Long Dim TwoBytes(1) As Byte Dim ThreeBytes(2) As Byte Dim AByte As Byte Dim TStr As String TopIndex = UBound(BArray) ' Number of bytes equal TopIndex+1 If TopIndex = 0 Then Exit Function ' get out if there's nothing to convert i = 0 ' Initialise pointer ' Iterate through the Byte Array Do While i <= TopIndex AByte = BArray(i) ' fetch a byte If AByte = &HE1 Then ' Start of 3 byte UTF-8 group for a character ' Copy 3 byte to ThreeBytes ThreeBytes(0) = BArray(i): i = i + 1 ThreeBytes(1) = BArray(i): i = i + 1 ThreeBytes(2) = BArray(i): i = i + 1 ' Convert Byte array to UTF-16 then Unicode TStr = TStr & ChrW(ToUTF16(ThreeBytes)) ElseIf (AByte >= &HC3) And (AByte <= &HC6) Then ' Start of 2 byte UTF-8 group for a character TwoBytes(0) = BArray(i): i = i + 1 TwoBytes(1) = BArray(i): i = i + 1 ' Convert Byte array to UTF-16 then Unicode TStr = TStr & ChrW(ToUTF16(TwoBytes)) Else ' Normal ANSI character - use it as is TStr = TStr & Chr(AByte): i = i + 1 ' Increment byte array index End If Loop UTF8ToUniStr = TStr ' Return the resultant string End Function Function HexDisplayOfFile(TFileName) As String ' Display the content of a text file in Hex format like: ' FF FE 54 00 B0 01 DB 1E 63 00 Dim Text1, MyChar, FileNum FileNum = FreeFile ' Obtain a File handle from the OS Open TFileName For Binary As #FileNum ' Open given Text file as binary ' Read all characters in the file. Do While Not EOF(FileNum) MyChar = Input(1, #FileNum) ' Read a character as raw binary If MyChar <> "" Then ' Convert byte to Hex like 0A, 6B etc.. Text1 = Text1 & HexOf(Asc(MyChar)) & " " End If Loop Close #FileNum ' Close file HexDisplayOfFile = Text1 ' Return the Hex display string End Function Function GetFileEncoding(TFileName) As coEncoding ' Return the type of Text file : UTF16LE, UTF-8 or ANSI Dim b1, FileNum On Error Resume Next ' Ignore error FileNum = FreeFile ' Obtain a File handle from the OS Open TFileName For Binary As #FileNum ' Open given Textfile as Binary ' Read all characters in the file. b1 = Input(1, #FileNum) ' Read the first character. If Asc(b1) = &HFF Then GetFileEncoding = coUnicode ' UTF-16LE ElseIf Asc(b1) = &HEF Then GetFileEncoding = coUTF8 ' UTF-8 Else GetFileEncoding = coANSI ' Normal ANSI End If Close #FileNum ' Close the file End Function Function ToUniDecimal(UniString As String) As String ' Return the HTML equivalent string of a Unicode string Dim i As Integer ' Must declare as integer for CopyMemory to work Dim TLen, TStr Dim b1 As Byte Dim b2 As Byte Dim UTF16 As Long TLen = Len(UniString) ' Get Length of input Unicode string If TLen = 0 Then Exit Function ' Get out if null string ' Iterate through each character in the string For i = 1 To TLen If IsUniChar(Mid(UniString, i, 1)) Then ' Cast the String character to 2 bytes CopyMemory b1, ByVal StrPtr(UniString) + ((i - 1) * 2), 1 CopyMemory b2, ByVal StrPtr(UniString) + ((i - 1) * 2) + 1, 1 ' Combine the 2 bytes into the Unicode UTF-16 UTF16 = b2 ' assign b2 to UTF16 before multiplying by 256 to avoid overflow UTF16 = UTF16 * 256 + b1 ' Convert UTF-16 to format ? for HTML TStr = TStr & "&#" & Trim(CStr(UTF16)) & ";" Else ' Get here if it;s an ANSI character TStr = TStr & Mid(UniString, i, 1) End If Next ToUniDecimal = TStr ' Return the HTML string End Function Private Function HexOf(ByVal AscNum As Integer) As String ' Return the 2 character Hex string of AscNum, prefix extra "0" if necessary Dim TStr If AscNum > 255 Then AscNum = AscNum Mod 256 TStr = Hex(AscNum) ' Convert to Hex If Len(TStr) = 1 Then ' Attach "0" on the left TStr = "0" & TStr End If HexOf = TStr ' Return the 2 character Hex string End Function

Topics: Công nghệ mới Quản trị cơ sở dữ liệu SQL

About Học viện đào tạo trực tuyến

Xinh chào bạn. Tôi là Đinh Anh Tuấn - Thạc sĩ CNTT. Email: [email protected] . - Nhận đào tạo trực tuyến lập trình dành cho nhà quản lý, kế toán bằng Foxpro, Access 2010, Excel, Macro Excel, Macro Word, chứng chỉ MOS cao cấp, IC3, tiếng anh, phần mềm, phần cứng . - Nhận thiết kế phần mềm quản lý, Web, Web ứng dụng, quản lý, bán hàng,... Nhận Thiết kế bài giảng điện tử, số hóa tài liệu... HỌC VIỆN ĐÀO TẠO TRỰC TUYẾN:TẬN TÂM-CHẤT LƯỢNG. «
Next
Bài đăng Mới hơn
»
Previous
Bài đăng Cũ hơn
Bài đăng Mới hơn Bài đăng Cũ hơn Trang chủ

Bài đăng nổi bật

Khóa Đào Tạo Hacker Mũ Trắng

Nhấn vào đây để bắt đầu khóa học   Giúp học viên tìm hiểu cơ bản bản chuyên sâu kỹ năng hack website, sever, email, sms, facebook... Khóa...

Tuyển tập hay nhất

Khóa học trực tuyến

Truy cập nhiều nhất

  • Hướng dẫn về ASP.NET MVC và Action Result Nếu bạn đã từng làm việc trong một dự án ASP.NET MVC thì chắc chẳng còn xa lạ gì với khái niệm Action result mà ASP.NET MVC đã và đang cung...
  • Hướng dẫn sử dụng phần mềm Anki - Học tiếng anh hiệu quả nhất Anki là một phần mềm được thiết kế để giúp bạn ghi nhớ các sự kiện, từ ngữ (chẳng hạn như từ ngữ trong một ngôn ngữ nước ngoài) một cách ...
  • Apple tung video quảng cáo độ bền và camera của iPhone 11 Pro Apple vừa tung hai đoạn video ngắn để quảng cáo cho độ bền và 3 camera trên iPhone 11 Pro . Bạn sẽ thấy là iPhone 11 Pro bị ném nh...
  • Phần mềm Bizagi Thiết kế, quản lý dữ liệu dự án cho doanh nghiệp Bizagi Modeler được thiết kế để diễn đạt hệ thống ký hiệu mô hình hóa tiến trình nghiệp vụ BPMN theo cấu trúc dự án, tiến tới mục tiêu tăng ...
  • Cách dùng Termux để cài phần mềm Hack trên điện thoại Android Mục lục bài viết Termux là gì? Cách cài đặt Có thể dùng Termux để Hack không? Cách cài đặt các công cụ hack trên Termux Cài NMAP – Công cụ ...
  • Những thói quen xấu đang "giết chết" chiếc laptop của bạn Laptop ngày càng khẳng định được vị thế quan trọng trong cuộc sống của con người hiện đại, song, ít ai biết được rằng, nh...
  • Giới thiệu cơ sở dữ liệu AdventureWorks Trước đây, khi nói tới cơ sở dữ liệu ví dụ của Microsoft chúng ta sẽ nghĩ ngay tới CSDL  Northwind , tuy nhiên từ khi giới thiệu SQL Server...
  • 108 câu hỏi trắc nghiệm và đáp án môn Quản Trị Mạng Câu hỏi và đáp án Câu 1. Địa chỉ IP có độ dài bao nhiêu bit và được phân thành bao nhiêu lớp? a. 32 bit, 4 lớp (A, B,C,D) ...
  • Tìm kiếm file trên Window theo nhiều điều kiện hoặc danh sách Bạn đã bao giờ phải tìm danh sách các file khi biết tên file của các nó; nếu bạn cần xử lý tình huống như vậy hãy sử dụng công cụ SearchMyF...
  • Những thông tin thú vị về quốc đảo Madagascar Madagascar là một quốc đảo ở Châu Phi, nằm ở Ấn Độ Dương bên phải của lục địa Phi châu. Các nhà khảo cổ ước tính rằng loài người đã đến địn...

Tin công nghệ

Download

Danh mục bài viết

  • 3ds Max
  • access
  • Adobe Illustrator
  • AI
  • android
  • Articulate Storyline
  • autoit
  • Bài thuốc
  • Cây xanh
  • Cây xanh trong nhà
  • CI Framework
  • Clip ca nhạc
  • Công nghệ Mobile
  • Công nghệ mới
  • Công nghệ số
  • css
  • DotnetNuke
  • Download
  • Đào tạo CorelDraw chuyên nghiệp
  • Đào tạo photoshop chuyên nghiệp
  • Định hướng lập trình
  • Đọc sách
  • excel
  • facebook
  • Foxpro
  • Giải pháp excel chuyên nghiệp
  • Giải trí
  • Giáo dục
  • Giới thiệu Phần mềm
  • Google Apps Script
  • Google Docs
  • Google drive
  • Google Sheets
  • Google Slide
  • HAcker
  • Hàng khuyến mại
  • hay
  • Hệ thống Elearning Moodle
  • Học tiếng anh
  • Học từ Youtobe
  • html
  • Hướng dẫn xây dựng và quản lý JOOMLA
  • Imacro
  • ios apple
  • Iphone
  • Khoa học dữ liệu
  • Khóa học hay
  • Khóa học trực tuyến
  • Kiểm thử phần mềm
  • Kiến thức cơ bản
  • Kiến thức cuộc sống
  • Kinh doanh
  • Kỹ năng
  • lập trình
  • Lập trình .NET
  • Lập trình AngularJS
  • Lập trình assembly
  • Lập trình di động
  • Lập trình Java
  • Lập trình Javascript
  • Lập trình Nodejs
  • Lập trình PHP
  • Machine Learning
  • Microsoft Teams
  • MP3
  • Nấu ăn
  • Nét xinh
  • Ôn luyện thi chứng chỉ MOS
  • phần cứng
  • Phần mềm cho Bé và Cha mẹ
  • PHP tool
  • powerpoint
  • Python
  • Quản trị cơ sở dữ liệu SQL
  • Quản trị dự án-công việc hiệu quả
  • Quản Trị Mạng
  • Sách nói
  • Sách nổi tiếng - Best Seller
  • Sáng tạo
  • SEO-Tối ưu công cụ tìm kiếm
  • skype
  • SPSS
  • Suy ngẫm hay
  • Sức khỏe
  • Symfony Framework
  • tết
  • Thiết kế đồ họa
  • Tin hay
  • Tin học Văn phòng
  • Toeic 500-700
  • Tranh treo
  • Unity 3D
  • vba
  • visio
  • web
  • word
  • wordpress
  • Xây dựng bài giảng điện tử
  • zalo

Nhóm Zalo CÔNG NGHỆ

Nhóm Zalo CÔNG NGHỆ Hiện nay có rất nhiều công việc mà bất cứ ai cũng có thể làm tốt khi không yêu cầu quá nhiều kiến thức chuyên môn, như: Bán hàng chẳng hạn. Ngồi một chỗ, với điện thoại và laptop là bạn có thể bán hàng 63 tỉnh thành, thậm chí toàn thế giới. Còn nếu bạn chưa biết bán hàng sao cho hiệu quả thì vào nhóm: HỌC VIỆN ĐÀO TẠO TRỰC TUYẾN.

Bảo hiểm nhân thọ - bảo vệ người trụ cột

Bảo hiểm nhân thọ - bảo vệ người trụ cột HỌC VIỆN ĐÀO TẠO TRỰC TUYẾN-TẬN TÂM-CHẤT LƯỢNG © 2014. All Rights Reserved.

Designed by [email protected] Tel: 098 909 5293

Pages

Từ khóa » Msgbox Tiếng Việt Vba