Function UniVBA và MsgUni hỗ trợ nhập tiếng việt (Font Unicode) trong VBA

Liên hệ QC

hoangdanh282vn

Nguyễn Cảnh Hoàng Danh
Thành viên danh dự
Tham gia
21/12/07
Bài viết
1,901
Được thích
5,297
Nghề nghiệp
Kinh doanh các mặt hàng văn phòng phẩm
Gửi các bạn 2 hàm chuyển đổi, hỗ trợ nhập tiếng việt trực tiếp trong VBA.

1. Hàm UniVBA(Str)

UniVBA("Nguye64n Ca3nh Hoa2ng Danh") = "Nguyễn Cảnh Hoàng Danh"
PHP:
Public Function UniVBA(Str As String) As String
Dim Ma As String, MaLuu As String, i As Long, a As Long
a = 1
For i = a To Len(Str)
i = a
Ma = Mid(Str, i, 3)
MaLuu = Ma
Select Case Ma
    Case "a81": Ma = ChrW(7855):     Case "A81": Ma = ChrW(7854)
    Case "a82": Ma = ChrW(7857):     Case "A82": Ma = ChrW(7856)
    Case "a83": Ma = ChrW(7859):     Case "A83": Ma = ChrW(7858)
    Case "a84": Ma = ChrW(7861):     Case "A84": Ma = ChrW(7860)
    Case "a85": Ma = ChrW(7863):     Case "A85": Ma = ChrW(7862)
    Case "a61": Ma = ChrW(7845):     Case "A61": Ma = ChrW(7844)
    Case "a62": Ma = ChrW(7847):     Case "A62": Ma = ChrW(7846)
    Case "a63": Ma = ChrW(7849):     Case "A63": Ma = ChrW(7848)
    Case "a64": Ma = ChrW(7851):     Case "A64": Ma = ChrW(7850)
    Case "a65": Ma = ChrW(7853):     Case "A65": Ma = ChrW(7852)
    Case "e61": Ma = ChrW(7871):     Case "E61": Ma = ChrW(7870)
    Case "e62": Ma = ChrW(7873):     Case "E62": Ma = ChrW(7872)
    Case "e63": Ma = ChrW(7875):     Case "E63": Ma = ChrW(7874)
    Case "e64": Ma = ChrW(7877):     Case "E64": Ma = ChrW(7876)
    Case "e65": Ma = ChrW(7879):     Case "E65": Ma = ChrW(7878)
    Case "o61": Ma = ChrW(7889):     Case "O61": Ma = ChrW(7888)
    Case "o62": Ma = ChrW(7891):     Case "O62": Ma = ChrW(7890)
    Case "o63": Ma = ChrW(7893):     Case "O63": Ma = ChrW(7892)
    Case "o64": Ma = ChrW(7895):     Case "O64": Ma = ChrW(7894)
    Case "o65": Ma = ChrW(7897):     Case "O65": Ma = ChrW(7896)
    Case "o71": Ma = ChrW(7899):     Case "O71": Ma = ChrW(7898)
    Case "o72": Ma = ChrW(7901):     Case "O72": Ma = ChrW(7900)
    Case "o73": Ma = ChrW(7903):     Case "O73": Ma = ChrW(7902)
    Case "o74": Ma = ChrW(7905):     Case "O74": Ma = ChrW(7904)
    Case "o75": Ma = ChrW(7907):     Case "O75": Ma = ChrW(7906)
    Case "u71": Ma = ChrW(7913):     Case "U71": Ma = ChrW(7912)
    Case "u72": Ma = ChrW(7915):     Case "U72": Ma = ChrW(7914)
    Case "u73": Ma = ChrW(7917):     Case "U73": Ma = ChrW(7916)
    Case "u74": Ma = ChrW(7919):     Case "U74": Ma = ChrW(7918)
    Case "u75": Ma = ChrW(7921):     Case "U75": Ma = ChrW(7920)
End Select
If Ma <> MaLuu Then
    UniVBA = UniVBA & Ma
    a = i + 3
Else
    Ma = Mid(Str, i, 2)
    MaLuu = Ma
    Select Case Ma
        Case "a1": Ma = ChrW(225):     Case "A1": Ma = ChrW(193)
        Case "a2": Ma = ChrW(224):     Case "A2": Ma = ChrW(192)
        Case "a3": Ma = ChrW(7843):    Case "A3": Ma = ChrW(7842)
        Case "a4": Ma = ChrW(227):     Case "A4": Ma = ChrW(195)
        Case "a5": Ma = ChrW(7841):    Case "A5": Ma = ChrW(7840)
        Case "a8": Ma = ChrW(259):     Case "A8": Ma = ChrW(258)
        Case "a6": Ma = ChrW(226):     Case "A6": Ma = ChrW(194)
        Case "d9": Ma = ChrW(273):     Case "D9": Ma = ChrW(272)
        Case "e1": Ma = ChrW(233):     Case "E1": Ma = ChrW(201)
        Case "e2": Ma = ChrW(232):     Case "E2": Ma = ChrW(200)
        Case "e3": Ma = ChrW(7867):    Case "E3": Ma = ChrW(7866)
        Case "e4": Ma = ChrW(7869):    Case "E4": Ma = ChrW(7868)
        Case "e5": Ma = ChrW(7865):    Case "E5": Ma = ChrW(7864)
        Case "e6": Ma = ChrW(234):     Case "E6": Ma = ChrW(202)
        Case "i1": Ma = ChrW(237):     Case "I1": Ma = ChrW(205)
        Case "i2": Ma = ChrW(236):     Case "I2": Ma = ChrW(204)
        Case "i3": Ma = ChrW(7881):    Case "I3": Ma = ChrW(7880)
        Case "i4": Ma = ChrW(297):     Case "I4": Ma = ChrW(296)
        Case "i5": Ma = ChrW(7883):    Case "I5": Ma = ChrW(7882)
        Case "o1": Ma = ChrW(243):     Case "O1": Ma = ChrW(211)
        Case "o2": Ma = ChrW(242):     Case "O2": Ma = ChrW(210)
        Case "o3": Ma = ChrW(7887):    Case "O3": Ma = ChrW(7886)
        Case "o4": Ma = ChrW(245):     Case "O4": Ma = ChrW(213)
        Case "o5": Ma = ChrW(7885):    Case "O5": Ma = ChrW(7884)
        Case "o6": Ma = ChrW(244):     Case "O6": Ma = ChrW(212)
        Case "o7": Ma = ChrW(417):     Case "O7": Ma = ChrW(416)
        Case "u1": Ma = ChrW(250):     Case "U1": Ma = ChrW(218)
        Case "u2": Ma = ChrW(249):     Case "U2": Ma = ChrW(217)
        Case "u3": Ma = ChrW(7911):    Case "U3": Ma = ChrW(7910)
        Case "u4": Ma = ChrW(361):     Case "U4": Ma = ChrW(360)
        Case "u5": Ma = ChrW(7909):    Case "U5": Ma = ChrW(7908)
        Case "u7": Ma = ChrW(432):     Case "U7": Ma = ChrW(431)
        Case "y1": Ma = ChrW(253):     Case "Y1": Ma = ChrW(221)
        Case "y2": Ma = ChrW(7923):    Case "Y2": Ma = ChrW(7922)
        Case "y3": Ma = ChrW(7927):    Case "Y3": Ma = ChrW(7926)
        Case "y4": Ma = ChrW(7929):    Case "Y4": Ma = ChrW(7928)
        Case "y5": Ma = ChrW(7925):    Case "Y5": Ma = ChrW(7924)
    End Select
    If Ma <> MaLuu Then
        UniVBA = UniVBA & Ma
        a = i + 2
    Else
        UniVBA = UniVBA & Mid(Str, i, 1)
        a = i + 1
    End If
End If
Next i
End Function
 
Lần chỉnh sửa cuối:
Trước tiên là cảm ơn bác về code này! Nhưng nhìn vô chói quá! (Mõi cả mắt luôn)
1232876992.jpg

Cái này chưa ổn bác ơi! Máy em nó chạy không được?
Em thấy cái phần mềm doanh nghiệp của bác chạy tốt đó! Vậy cho em xin code trong đó nha!
Thân.
 
Upvote 0
Trước tiên là cảm ơn bác về code này! Nhưng nhìn vô chói quá! (Mõi cả mắt luôn)
1232876992.jpg

Cái này chưa ổn bác ơi! Máy em nó chạy không được?
Em thấy cái phần mềm doanh nghiệp của bác chạy tốt đó! Vậy cho em xin code trong đó nha!
Thân.

Trong topic mình gửi cũng đã giải thích tại sao font chữ như trên đó, bạn tìm đọc lại nhé. Lý do chính là font hệ thống chưa đúng là Unicode, bạn hãy chỉnh font trong Control Panel về Tahoma nhé. Ba
 
Upvote 0
Trước tiên là cảm ơn bác về code này! Nhưng nhìn vô chói quá! (Mõi cả mắt luôn)
1232876992.jpg

Cái này chưa ổn bác ơi! Máy em nó chạy không được?
Em thấy cái phần mềm doanh nghiệp của bác chạy tốt đó! Vậy cho em xin code trong đó nha!
Thân.


Anh hiện không được trên caption là do chưa chỉnh lại fónt hệ thống. Còn về hiển thị tiềng việt của anh Hoàng danh thì không hiểu sao máy em chạy rất tốt mặc dù font hệ thống bị lỗi "Vì em có sài thử MSgboxuni của anh tuanVNI bị lỗi máy chữ mặc dù đã chỉnh lại và cài lại fónt hệ thống nhưng không hiện được" em chẳng hiểu tại sao nưã ?
 
Lần chỉnh sửa cuối:
Upvote 0
Thật sự thì em bó tay với cách bác chỉ luôn rồi! (Đầu hàng vô điều kiện)
Với phần mềm kế toán doanh nghiệp thì bác là thật tuyệt vời. Nhưng em xem code thì chẳng thấy cái gì liên quan trong code của Excel cả. Chắc bác đã lập trình chúng trên 1 trình khác không phải VBA (VBE).
Nên thôi vậy! Chúc bác 1 năm mới vui vẻ và hạnh phúc.
Em thì bó tay hoàn toàn.
Xin kiếu!
Thân.
 
Upvote 0
Thật sự thì em bó tay với cách bác chỉ luôn rồi! (Đầu hàng vô điều kiện)
Với phần mềm kế toán doanh nghiệp thì bác là thật tuyệt vời. Nhưng em xem code thì chẳng thấy cái gì liên quan trong code của Excel cả. Chắc bác đã lập trình chúng trên 1 trình khác không phải VBA (VBE).
Nên thôi vậy! Chúc bác 1 năm mới vui vẻ và hạnh phúc.
Em thì bó tay hoàn toàn.
Xin kiếu!
Thân.

Trong PM kế toán doanh nghiệp, tôi đã phải làm một động tác trước khi ứng dụng chạy là kiểm tra font hệ thống, nếu font hệ thống không phải chuẩn Unicode thì sẽ thiết lập lại. Khi Uninstall thì khôi phục lại trạng thái cũ.

Đã có lần tôi đã trả lời một bạn về vấn đề font Unicode trong Windows:

Rất có thể máy bạn đã cài ít nhất một PM Việt Nam nào đó và nó đã làm hỏng các font chuẩn của hệ thống như Tahoma, Verdana,...

Những PM của người Việt làm trước đây (có tên tuổi hẳn hoi) trên môi trường (VS) Foxpro, VB6 thường họ không làm được unicode nên đã làm ra (có thể sửa từ font chuẩn của Windows) file font Tahoma (chỉ hỗ trợ kiểu font ABC/TCVN3) và copy đè vào font chuẩn của Windows (hỗ trợ unicode). Cách làm PM như thế thì làm được một việc thì phá nhiều việc khác trên máy tính của người dùng :=\+.

Giải pháp, bạn hãy vào Control Panel->(Appearance and Themes) ->Display-> Appearance->Advanced chỉnh lại font:
+ nếu hiện tại không phải Tahoma thì hãy thay bằng Tahoma
+ nếu hiện tại lại Tahoma thì thay bằng font khác như Verdana hoặc Times New Roman.

Đến bây giờ rất nhiều người Việt Nam hiều không đúng về font chữ Việt Nam & chuẩn Unicode trên máy tính có lẽ là một hệ quả của sự phát hành nhiều PM Việt không thực sự chuẩn.

Nhiều PM mới hiện nay đã làm bằng công nghệ .NET + Delphi 2009 thì đã thực sự làm chuẩn font Unicode, cộng đồng GPE thì tương lai gần không biết liệu sẽ phải dần xa VBA để đến với kỹ thuật mới .NET không !/? (vì có thể MS không thực sự hỗ trợ VBA trong Office mới nữa), đến lúc đó có thể trên GPE sẽ để lại một box nhỏ là "VBA - Chuyện ngày xưa" --=0

Về vấn đề Unicode mọi người có thể tin tôi!

Năm mới cũng chúc các bác thành công trong nhiều lĩnh vực. Đặc biệt các ứng dụng làm trong VBA của các bác sớm thành công!
 
Upvote 0
Không hiện được tiếng Việt trên form

Nếu là trên Application thì chỉ cần dùng hàm UniVBA của mình là ok, Po_Pikachu thử đưa nó lên thanh tiêu đề trên User Form thử nha.
PHP:
Sub workbook_open()
Application.Caption = UniVBA("Nguye64n Ca3nh Hoa2ng Danh")
End Sub
UniVBA của bạn chỉ đúng trường hợp workbook_open() thôi chứ trên thanh tiêu đề form cũng như msg trên formthif không được!
 
Upvote 0
UniVBA của bạn chỉ đúng trường hợp workbook_open() thôi chứ trên thanh tiêu đề form cũng như msg trên formthif không được!

Cái mà bạn nói thì bạn tìm bài viết của anh TuanVNUNI đó Free code không những thế mà còn cả nguyên bộ Control Unicode cho VBA nữa (Cao thủ Unicode)}}}}}
 
Upvote 0
Mã:
MsgUni "Nguye64n Ca3nh Hoa2ng Danh", , "Ba1o lo64i"
kết quả:
UniVBA.jpg


Nó không hiện đúng ký tự
 
Upvote 0
Cám ơn thấy. Trước giờ em không để ý tới nó lắm. Giờ mới thấy lỗi.

Sau khi kiềm tra thì em nhận thấy rằng với nội dung của MsgUni thì cho phép nhập font Unicode đầy đủ. Riêng đối với phần tiêu đề thì có phát sinh lỗi.

Phần tiêu đề nó chỉ nhận chữ với Font Unicode có hai ký tự liền kề như : O6~Ô, A8~Ă, A1~Á... Còn với chữ có 3 ký tự liền kề thì báo lỗi như O64~Ỗ, A81~Ắ, U71~Ứ..

Em nghĩ là do hàm MessageBoxW nó không hỗ trợ đầy đủ. Không biết có đúng không, nhờ các bạn xem giúp.
 
Upvote 0
Vì tiếng Việt Unicode là font 2 byte ---> Ký tự nào có Byte trên = 0 thì hiển thị bình thường.. Ngược lại thì bị lổi
Danh có thể thí nghiệm thế này:
- gõ chữ gì đó vào cell A1 (chẳng hạn là chữ báo lỗi )
- Dùng code này kiểm tra:
PHP:
Sub Test()
  Dim A() As Byte, i As Long
  A = Range("A1").Value
  For i = 0 To UBound(A)
    MsgBox A(i)
  Next i
End Sub
Kết quả:
- Chữ b = 66 và 0
- Chữ á = 225 và 0
- Chữ o = 111 và 0
- Chữ l = 108 và 0
- Chữ ỗ = 215 và 30
- Chữ i = 105 và 0
Hàm AscW("ỗ") cho kết quả = 7895 chính là kết quả của phép tính:
=HEX2DEC(DEC2HEX(30)&DEC2HEX(215))
 
Lần chỉnh sửa cuối:
Upvote 0
Cám ơn thấy. Trước giờ em không để ý tới nó lắm. Giờ mới thấy lỗi.

Sau khi kiềm tra thì em nhận thấy rằng với nội dung của MsgUni thì cho phép nhập font Unicode đầy đủ. Riêng đối với phần tiêu đề thì có phát sinh lỗi.

Phần tiêu đề nó chỉ nhận chữ với Font Unicode có hai ký tự liền kề như : O6~Ô, A8~Ă, A1~Á... Còn với chữ có 3 ký tự liền kề thì báo lỗi như O64~Ỗ, A81~Ắ, U71~Ứ..

Em nghĩ là do hàm MessageBoxW nó không hỗ trợ đầy đủ. Không biết có đúng không, nhờ các bạn xem giúp.

Em đã tiến hành chạy thử ở các máy khác nhau và kết quả cũng khác nhau.

Trên máy của em thì bị lỗi, ở trên máy của một người bạn thì chạy bình thường. Đồng thời trên máy của em, Font chữ trên Caption của file Excel cũng bị lỗi tương tự. Nhưng Caption của file Excel khi nằm trên thanh Taskbar lại bình thường. Em nghĩ có thể do máy của người sử dụng bị thiếu font hệ thống hay một lỗi gì đó.

Các bạn xem hình minh họa đính kèm nha
 

File đính kèm

  • Loi Font.rar
    56.9 KB · Đọc: 132
Upvote 0
cái này anh TuanVNI có nói "Theo ngầm định, Caption (Title) của Form (Window) đặt font là "Trebuchet MS".
Để hiển thị font Unicode, bạn hãy đổi về font trên Caption về "Tahoma" hoặc "Verdana" hoặc "Time New Roman"."

Anh thử xem hết lỗi không
Destop - Properties - chon tab apperarace - chon Advance
 
Upvote 0
Cái Caption của Form thì mình không nói tới, vì tới giờ mình vẫn chưa thể hiện được đầy đủ tiếng việt trên nó. Cái mình nói tới là Caption của Msgbox và Application cơ. Hai cái này có lúc được lúc không tùy theo máy.
Theo mình nghĩ thì có lẽ do hệ thống Font của máy bị lỗi. Nếu chỉnh lại Font hệ thống về Tahoma thì ok.
 
Lần chỉnh sửa cuối:
Upvote 0
2. Hàm MsgUni

Hàm MsgUni được sự hỗ trợ của Hàm API MessageBox và UniVBA
PHP:
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long


Public Function MsgUni(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Tho6ng ba1o !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult

MsgUni = MessageBox(Khac, StrPtr(UniVBA(Chuoi)), StrPtr(UniVBA(Tieude)), Bieutuong)
End Function

Với các hàm trên ta có thể nhập chữ tiếng việt trên VBA khi xuất dữ liệu ra Worksheet, Captain của application, Msgbox, PopManu..

Tuy nhiên hàm trên vẫn chưa áp dụng được cho Captain trên userform

Khi thực hiện bảng thông báo này thì nó còn 1 vấn đề là khi thông báo này hiện lên, mình không bấm OK, tiếp tục chạy code tiếp, nó lại tiếp tục hiện 1 cái MsgUni nữa...
 
Upvote 0
Tôi có 1 vấn đề mới phát sinh mà tìm mãi không biết nguyên nhân vì sao: Trước đây tôi chỉ cài bộ Office 2003 và sài hàm chuyển đổi font sang Unicode của Pác Tuân thì ngon lành. Nhưng chả hiểu làm sao từ khi cài thêm bộ Office 2010 song hành cùng bộ Office 2003 thì bị lỗi font.......không biết có phải do cài thêm Office 2010.......nhờ các Pác chỉ giúp.
 

File đính kèm

  • FonttrenMgsbox.jpg
    FonttrenMgsbox.jpg
    9.2 KB · Đọc: 222
Upvote 0
sao mình vẫn dùng code của hoàng doanh bình thường mà, mình xài win 8.1, với lại cho mình hỏi thêm, hàm Uni(sText As String) dùng để làm gì vậy, và cách dùng nó thế nào, thank bạn hoàng doanh đã chia sẽ
Capture.JPG
 
Lần chỉnh sửa cuối:
Upvote 0
Không hiểu code lắm

sao mình vẫn dùng code của hoàng doanh bình thường mà, mình xài win 8.1, với lại cho mình hỏi thêm, hàm Uni(sText As String) dùng để làm gì vậy, và cách dùng nó thế nào, thank bạn hoàng doanh đã chia sẽ
View attachment 149093
Bác ơi cho tôi hỏi, trong đoạn code của bác Hoàng Doanh có đoạn
"Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _ ByVal lpText As Long, _
ByVal lpCaption As Long, _
ByVal wType As Long) As Long"
Khi copy vào vba editor thì báo lỗi, mà em thấy function này không có nội dung và kết thúc hả bác?! Em mới tìm hiều về vba nên chưa hiểu lắm, mong bác chỉ dùm em với ạ. Thank nhiều ạ!
 
Upvote 0
MsgUniT :

PHP:
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hwnd As Long, _
                                                                          ByVal lpText As Long, _
                                                                          ByVal lpCaption As Long, _
                                                                          ByVal wType As Long) As Long


Public Function MsgUniT(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Thoong baso !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult

MsgUniT = MessageBox(Khac, StrPtr(UniVBAT(Chuoi)), StrPtr(UniVBAT(Tieude)), Bieutuong)
End Function
Bác ơi, cho em hỏi, khi em copy code vào thì bị lỗi này ạ! Em dùng office 2016
2016-12-21_210053.jpg
 
Upvote 0
Bác ơi, cho em hỏi, khi em copy code vào thì bị lỗi này ạ! Em dùng office 2016
View attachment 169925
Bạn sử dụng code này xem sao.
Mã:
Private Declare PtrSafe Function MessageBoxW Lib "user32" (ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long


Public Function MsgUniT(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
                        Optional ByVal Tieude As String = "Thoong baso !", _
                        Optional ByVal Khac As Long = 0) As VbMsgBoxResult


MsgUniT = MessageBox(Khac, StrPtr(UniVBAT(Chuoi)), StrPtr(UniVBAT(Tieude)), Bieutuong)
End Function
 
Upvote 0
Web KT

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

Back
Top Bottom