[Chia sẻ] Thủ tục VBA hiển thị tiếng Việt trên ListView và chép tiếng Việt từ ListView vào bảng tính.

Liên hệ QC

Maika8008

Thành viên gạo cội
Tham gia
12/6/20
Bài viết
4,741
Được thích
5,669
Donate (Momo)
Donate
Giới tính
Nam
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:
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.
 

File đính kèm

  • TiengVietChoListView.xlsm
    34.2 KB · Đọc: 48
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:
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.
Anh ơi, cho em hỏi sao em cứ bị kiểu thể này khi di chuyển chuột anh nhỉ ?2023-04-07_20-00-01.png
 
Upvote 0
Vâng anh, em chỉ rê chuột thì nó cứ tự tạo ra cái ô đấy và SetFocus vào đó luôn nên cảm thấy rất khó chịu. Cảm ơn anh vì chia sẻ rất hữ ích
Đơn giản là vì còn một cột STT bị ẩn trước đó nên khi rê chuột là nó hiển thị ra.
Bạn chỉ cần vô Properties của Listview -> kiếm mục Label Edit - chọn Manual là được rồi.
 
Upvote 0
Đơn giản là vì còn một cột STT bị ẩn trước đó nên khi rê chuột là nó hiển thị ra.
Bạn chỉ cần vô Properties của Listview -> kiếm mục Label Edit - chọn Manual là được rồi.
Bác từng giúp em vụ load data từ file Access sang listview. Tuy nhiên, khi dữ liệu từ file access là tiếng Việt load sang Listview sẽ bị lỗi font chữ. Bác có cách nào khắc phục được không ah?
 
Upvote 0
Bác từng giúp em vụ load data từ file Access sang listview. Tuy nhiên, khi dữ liệu từ file access là tiếng Việt load sang Listview sẽ bị lỗi font chữ. Bác có cách nào khắc phục được không ah?
ListView mặc định không hỗ trợ Unicode nên tốt nhất là bạn dùng OCX của bên thứ 3.
Cách xử lý Listview của bác @Maika8008 ở bài #1 chỉ dùng trong trường hơp đó thôi. Nếu bạn tải dữ liệu từ nguồn khác đổ hàng loạt vào Listview thì code trên không phù hợp rồi.
Thay vì mất thời gian ngâm cứu thì dùng cái bác Tuân đã ngâm cứu và làm sẵn luôn rồi đó: BSAC - Bluesofts ActiveX Controls. Triển khai vào ứng dụng cho nhanh.
 
Upvote 0
ListView mặc định không hỗ trợ Unicode nên tốt nhất là bạn dùng OCX của bên thứ 3.
ListView hỗ trợ đầy đủ Unicode nha anh

Bài viết bên này em có khởi tạo ListView sử dụng WinApi, thay vì sử dụng trong bộ ActiveX Controls:

Lập trình mã WinApi không đơn giản nên chỉ dành cho Lập trình Viên.
 
Upvote 0
ListView mặc định không hỗ trợ Unicode

Em chắc chắn với anh rằng không phải do ListView.

Nếu anh dùng Windows và Office phiên bản ngôn ngữ (Tàu, Thái, Hàn, Nhật...) nào thì đảm bảo trong code dùng được (tên sub/ function/ tên biến) đều dùng được, trên UI đều hiển thị ngon lành ngôn ngữ đó. Chẳng cần API khỉ gió gì cả, cứ thế mà gõ mà dùng thôi.

Cái vụ liên quan tới encoding này em nói mấy lần rồi. Trong này cũng thấy khá nhiều bài có người úp file có VBA chữ tiếng Nhật làm bằng chứng rồi đó.
 
Upvote 0
Nếu anh dùng Windows và Office phiên bản ngôn ngữ (Tàu, Thái, Hàn, Nhật...) nào thì đảm bảo trong code dùng được (tên sub/ function/ tên biến) đều dùng được, trên UI đều hiển thị ngon lành ngôn ngữ đó.
Vậy phải đổi phiên bản ngôn ngữ Office à, không đổi có được không? Để tôi tìm hiểu xem.
Bạn @donghung1512 tìm hiểu các cách ở trên thử đi nhé, khi rảnh rỗi tôi mới ngâm cứu được, tính tôi thích chọn việc nhẹ nhàng...cái nào dễ dễ chút thì làm ..:D;)
 
Lần chỉnh sửa cuối:
Upvote 0
ListView hỗ trợ đầy đủ Unicode nha anh

Bài viết bên này em có khởi tạo ListView sử dụng WinApi, thay vì sử dụng trong bộ ActiveX Controls:

Lập trình mã WinApi không đơn giản nên chỉ dành cho Lập trình Viên.

Khi người ta lập trình dùng activex control ListView thì họ dùng cả các sự kiện, các thành phần thuộc tính nhiều lắm. Nếu chỉ hiển thị thôi thì dùng API tạo control ListView unicode như của bác tạm ổn. Cách lập trình API và dùng activex hỗ trợ unicode là chuẩn nhất. Các cách khác chỉ thí nghiệm cho vui thôi.
 
Upvote 0
Khi người ta lập trình dùng activex control ListView thì họ dùng cả các sự kiện, các thành phần thuộc tính nhiều lắm. Nếu chỉ hiển thị thôi thì dùng API tạo control ListView unicode như của bác tạm ổn. Cách lập trình API và dùng activex hỗ trợ unicode là chuẩn nhất. Các cách khác chỉ thí nghiệm cho vui thôi.
ListView Api thiếu sự kiện gì mà bạn cần sao?
 
Upvote 0
Bác từng giúp em vụ load data từ file Access sang listview. Tuy nhiên, khi dữ liệu từ file access là tiếng Việt load sang Listview sẽ bị lỗi font chữ. Bác có cách nào khắc phục được không ah?
Cài các BSAC.OCX, dùng BSListview, đổi tên một số phương thức, thuộc tính cho phù hợp là xài được rồi. :cool:

Screen Shot 2023-08-16 at 15.01.37.png
 
Upvote 0
ListView Api thiếu sự kiện gì mà bạn cần sao?

Rất nhiều sự kiện trong ListView cần là:
BeforeLabelEdit
AfterLabelEdit
Click
ColumnClick
DblClick
ItemCheck
ItemClick
KeyDown
KeyPress
KeyUp
MouseDown
MouseUp
MouseMove

Cái của bác chỉ hiển thị thông tin thôi, không thực hiện các sự kiện được.
 
Upvote 0
Rất nhiều sự kiện trong ListView cần là:
BeforeLabelEdit
AfterLabelEdit
Click
ColumnClick
DblClick
ItemCheck
ItemClick
KeyDown
KeyPress
KeyUp
MouseDown
MouseUp
MouseMove

Cái của bác chỉ hiển thị thông tin thôi, không thực hiện các sự kiện được.

API còn nhiều hơn thế, có thể tùy biến, sáng tạo thêm.
 
Upvote 0
API còn nhiều hơn thế, có thể tùy biến, sáng tạo thêm.

ListView là của Microsoft cung cấp nên họ cấp đủ hàm API để làm với nó rồi, chỉ là để viết được các sự kiện cho ListView và đóng gói thành control cho người lập trình VBA để tạo trên nhiều userform có vẻ rất khó, mình chưa thấy ai làm bằng vba vụ này tốt cả, tìm mỏi mắt trên google rồi.
 
Upvote 0
Web KT
Back
Top Bottom