Maika8008
Thành viên gạo cội
Từ chủ đề của 1 thành viên (@dinhthientan) về việc không thể chép từ ListView đến bảng tính mà ra đúng tiếng Việt, mặc dù trên ListView thấy rõ đúng tiếng Việt, tôi đã viết hàm xử lý cho bạn ấy xong rồi nhưng cái code đó dở hơi quá. Nay rảnh rỗi, tôi sửa lại code và chia sẻ lên đây cho ai có nhu cầu tương tự như vậy.
1. Các khai báo public và hàm hiển thị tiếng Việt trên ListView bằng bảng mã Win 1258 là của thành viên ấy sưu tầm:
2. Hàm của tôi trả ngược lại bảng mã Unicode dựng sẵn để chép lên bảng tính:
Cũng có 1 thành viên dù không dùng bất kỳ thủ tục VBA nào nhưng lại không gặp vấn đề gì về tiếng Việt khi chép từ ListView xuống bảng tính, chưa hiểu lý do thế nào. Nếu mọi người chạy thử file đính kèm thấy có bất kỳ vấn đề gì thì hãy bình luận bên dưới để chúng ta cùng thảo luận.
1. Các khai báo public và hàm hiển thị tiếng Việt trên ListView bằng bảng mã Win 1258 là của thành viên ấy sưu tầm:
Rich (BB code):
Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As Long
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 Const VIETNAMESE_CHARSET = 163
' ma dung san cua nhung ky tu Viet
Private Const dungsan_code = "224 7843 227 225 7841 226 7847 7849 7851 7845 7853 259 7857 7859 7861 7855 7863 192 7842 195 193 7840 194 7846 7848 7850 7844 7852 258 7856 7858 7860 7854 7862 273 272 232 7867 7869 233 7865 234 7873 7875 7877 7871 7879 200 7866 7868 201 7864 202 7872 7874 7876 7870 7878 236 7881 297 237 7883 204 7880 296 205 7882 242 7887 245 243 7885 417 7901 7903 7905 7899 7907 244 7891 7893 7895 7889 7897 210 7886 213 211 7884 416 7900 7902 7904 7898 7906 212 7890 7892 7894 7888 7896 249 7911 361 250 7909 432 7915 7917 7919 7913 7921 217 7910 360 218 7908 431 7914 7916 7918 7912 7920 7923 7927 7929 253 7925 7922 7926 7928 221 7924"
' ma to hop cua nhung ky tu Viet
Private Const tohop_code1 = "50331745 50921569 50528353 50397281 52625505 226 50331874 50921698 50528482 50397410 52625634 259 50331907 50921731 50528515 50397443 52625667 50331713 50921537 50528321 50397249 52625473 194 50331842 50921666 50528450 50397378 52625602 258 50331906 50921730 50528514 50397442 52625666 273 272 50331749 50921573 50528357 50397285 52625509 234 50331882 50921706 50528490 50397418 52625642 50331717 50921541 50528325 50397253 52625477 202 50331850 50921674 50528458 50397386 52625610 50331753 50921577 50528361 50397289 52625513 50331721 50921545 50528329 50397257 52625481 50331759 "
Private Const tohop_code2 = "50921583 50528367 50397295 52625519 417 50332065 50921889 50528673 50397601 52625825 244 50331892 50921716 50528500 50397428 52625652 50331727 50921551 50528335 50397263 52625487 416 50332064 50921888 50528672 50397600 52625824 212 50331860 50921684 50528468 50397396 52625620 50331765 50921589 50528373 50397301 52625525 432 50332080 50921904 50528688 50397616 52625840 50331733 50921557 50528341 50397269 52625493 431 50332079 50921903 50528687 50397615 52625839 50331769 50921593 50528377 50397305 52625529 50331737 50921561 50528345 50397273 52625497"
Private Const win_1258 = "aÌaÒaÞaìaòâ âÌâÒâÞâìâòã ãÌãÒãÞãìãòAÌAÒAÞAìAò ÂÌÂÒÂÞÂìÂòà ÃÌÃÒÃÞÃìÃòð Ð eÌeÒeÞeìeòê êÌêÒêÞêìêòEÌEÒEÞEìEòÊ ÊÌÊÒÊÞÊìÊòiÌiÒiÞiìiòIÌIÒIÞIìIòoÌoÒoÞoìoòõ õÌõÒõÞõìõòô ôÌôÒôÞôìôòOÌOÒOÞOìOòÕ ÕÌÕÒÕÞÕìÕòÔ ÔÌÔÒÔÞÔìÔòuÌuÒuÞuìuòý ýÌýÒýÞýìýòUÌUÒUÞUìUòÝ ÝÌÝÒÝÞÝìÝòyÌyÒyÞyìyòYÌYÒYÞYìYò"
Public Function Font_ToLv(ByVal text As String) As String
' chuyen unicode dung san hoac to hop ve unicode dung san (UniToWindows1258)
Dim n As Integer, k As Integer
Dim s As String, tohop_code As String
text = text + " "
tohop_code = tohop_code1 + tohop_code2
s = ""
n = 1
k = Len(text)
While n < k
kytu1 = Mid(text, n, 1)
kytu2 = Mid(text, n + 1, 1)
codkytu = CStr(65536 * AscW(kytu2) + AscW(kytu1))
If Len(codkytu) < 8 Then codkytu = codkytu & String(8 - Len(codkytu), " ")
Index = InStr(1, tohop_code, codkytu, 0)
If (Index Mod 9) = 1 Then
' la ky tu Viet unicode to hop
n = n + 2
s = s & Trim(Mid(win_1258, (2 * Index + 7) / 9, 2))
Else
n = n + 1
Index = InStr(1, dungsan_code, AscW(kytu1), 0)
If (AscW(kytu1) > 127) And ((Index Mod 5) = 1) Then
' la ky tu Viet unicode dung san
s = s & Trim(Mid(win_1258, (2 * Index + 3) / 5, 2))
Else
' khong la ky tu Viet unicode
s = s & kytu1
End If
End If
Wend
Font_ToLv = s
End Function
2. Hàm của tôi trả ngược lại bảng mã Unicode dựng sẵn để chép lên bảng tính:
Rich (BB code):
Public Function Font_ToSheet(ByVal text As String) As String
Dim i&, VT&, lgNum&, sKT$, sKQ$, lgN&
Const sChr = "ÃìÃÌÃÒÃÞÃòãìãÌãÒãÞãòÕìÕÌÕÒÕÞÕòõìõÌõÒõÞõòÝìÝÌÝÒÝÞÝòýìýÌýÒýÞýò"
Const sNum = "785478567858786078627855785778597861786378987900790279047906789979017903790579077912791479167918792079137915791779197921"
Const sNum2 = "258259416417431432": Const PhuAm = "bcdghklmnpqrstvx "
text = text & " "
For i = 1 To Len(text)
If InStr(1, sChr, Mid(text, i, 2)) Then
lgNum = Mid(sNum, (InStr(1, sChr, Mid(text, i, 2)) - 1) * 2 + 1, 4)
sKQ = sKQ & ChrW(lgNum): i = i + 1: GoTo N1
ElseIf InStr(1, sChr, Mid(text, i, 1)) Then
lgN = InStr(1, sChr, Mid(text, i, 1))
If lgN = 1 Then lgNum = 258: GoTo T1
lgNum = Mid(sNum2, (CLng(Left(lgN, 1)) + CLng(Mid(lgN, 2, 1)) - 1) * 2 + CLng(Left(lgN, 1)) + CLng(Mid(lgN, 2, 1)), 3)
T1: sKQ = sKQ & ChrW(lgNum): GoTo N1
End If
If Mid(text, i, 1) = ChrW(240) Then sKQ = sKQ & ChrW(273): GoTo N1
If LCase(Mid(text, i, 1)) = ChrW(273) Then sKQ = sKQ & Mid(text, i, 1): GoTo N1
If Mid(text, i, 1) = "Ð" Then sKQ = sKQ & Mid(text, i, 1): GoTo N1
If InStr(1, PhuAm, LCase(Mid(text, i, 1))) = 0 Then
sKT = Mid(text, i, 2)
If InStr(1, win_1258, sKT, vbBinaryCompare) Then
VT = Trim(Mid(dungsan_code, (5 * InStr(1, win_1258, sKT, vbBinaryCompare) - 3) / 2, 5))
If Right(sKT, 1) = " " Then
sKQ = sKQ & ChrW(VT) & " "
Else
sKQ = sKQ & ChrW(VT)
End If
i = i + 1
Else
sKQ = sKQ & Mid(text, i, 1)
End If
Else
sKQ = sKQ & Mid(text, i, 1)
End If
N1:
Next
Font_ToSheet = Trim(sKQ)
End Function
Cũng có 1 thành viên dù không dùng bất kỳ thủ tục VBA nào nhưng lại không gặp vấn đề gì về tiếng Việt khi chép từ ListView xuống bảng tính, chưa hiểu lý do thế nào. Nếu mọi người chạy thử file đính kèm thấy có bất kỳ vấn đề gì thì hãy bình luận bên dưới để chúng ta cùng thảo luận.