Chuyển chữ sang bảng mã unicode (4 người xem)

[vanlethanh]

Hi các bạn,
Mình có 1 file excel font chữ vietsea sample font, hiện tại mình muốn chuyển qua font chữ Times new roman (bảng mã Unicode). Mình có sử dụng thử công cụ chuyển bảng mã trong phần mềm Unikey nhưng không được. Bạn nào biết xin hướng dẫn giúp.
Cám ơn các bạn

 

[huhumalu]

https://www.giaiphapexcel.com/diendan/threads/110161/post-690549

Bạn tham khảo hàm Tcvn2Unicode
hoặc một số tool trên diễn đàn có thể làm tốt việc này.

Public Function Tcvn2Unicode(ByVal strTcvn As String) As String
Static Dic As Object
Dim tcvnChars As String, UniChars, r As Long
If Dic Is Nothing Then
    Set Dic = CreateObject("Scripting.Dictionary")
    tcvnChars = "¸µ¶·¹¨¾»¼½Æ©ÊÇÈÉËÐÌÎÏѪÕÒÓÔÖãßáâä«èåæçé¬íêëìîÝ×ØÜÞóïñòôøõö÷ùýúûüþ®¡¢£¤¥¦§"
    UniChars = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, _
    7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 243, 242, 7887, _
    245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 237, 236, 7881, _
    297, 7883, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, _
    7925, 273, 258, 194, 202, 212, 416, 431, 272)
    For r = 1 To Len(tcvnChars) Step 1
        Dic(Mid(tcvnChars, r, 1)) = ChrW$(UniChars(r - 1))
    Next
End If
For r = 1 To Len(strTcvn) Step 1
    If Dic.exists(Mid(strTcvn, r, 1)) Then Mid(strTcvn, r, 1) = Dic(Mid(strTcvn, r, 1))
Next
Tcvn2Unicode = strTcvn
End Function

 

[huuthang_bd]

https://www.giaiphapexcel.com/diendan/threads/110161/post-690549

Bạn tham khảo hàm Tcvn2Unicode
hoặc một số tool trên diễn đàn có thể làm tốt việc này.

Public Function Tcvn2Unicode(ByVal strTcvn As String) As String
Static Dic As Object
Dim tcvnChars As String, UniChars, r As Long
If Dic Is Nothing Then
    Set Dic = CreateObject("Scripting.Dictionary")
    tcvnChars = "¸µ¶·¹¨¾»¼½Æ©ÊÇÈÉËÐÌÎÏѪÕÒÓÔÖãßáâä«èåæçé¬íêëìîÝ×ØÜÞóïñòôøõö÷ùýúûüþ®¡¢£¤¥¦§"
    UniChars = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, _
    7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 243, 242, 7887, _
    245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 237, 236, 7881, _
    297, 7883, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, _
    7925, 273, 258, 194, 202, 212, 416, 431, 272)
    For r = 1 To Len(tcvnChars) Step 1
        Dic(Mid(tcvnChars, r, 1)) = ChrW$(UniChars(r - 1))
    Next
End If
For r = 1 To Len(strTcvn) Step 1
    If Dic.exists(Mid(strTcvn, r, 1)) Then Mid(strTcvn, r, 1) = Dic(Mid(strTcvn, r, 1))
Next
Tcvn2Unicode = strTcvn
End Function

Kết quả có đúng đâu bạn.

 

[huhumalu]

Kết quả có đúng đâu bạn.

Do qua nhanh quá, thấy chạy được chữ Nguyễn tưởng đã đúng mã nguồn.
Font này hơi lạ năm 1995;
Gửi font lên mọi người nghiên cứu luôn.

Seachar ="§ª¨©« ¯¬®µ¡½¶·¸¾ÐÆÇÏÑ¢ÕÒÓÔÖãßáâä£èåæçé¤íêëìîÝ×ØÜÞóïñòô¥øõö÷ùýúûüþ¦™š›œ¤¥Ÿ"
Tới đây rồi mà không biết mần sao nữa.

 

[huhumalu]

Public Function Vietsea2Unicode(ByVal strTcvn As String) As String
Static Dic As Object
Dim seaChars As String, UniChars, r As Long
If Dic Is Nothing Then
    Set Dic = CreateObject("Scripting.Dictionary")
    'tcvnChars = "¸µ¶·¹¨¾»¼½Æ©ÊÇÈÉËÐÌÎÏѪÕÒÓÔÖãßáâä«èåæçé¬íêëìîÝ×ØÜÞóïñòôøõö÷ùýúûüþ®¡¢£¤¥¦§"
      seaChars = "ª§¨©« ¯¬®µ¡½¶·¸¾ÐÆÇÏÑ¢ÕÒÓÔÖãßáâä£èåæçé¤íêëìîÝ×ØÜÞóïñòô¥øõö÷ùýúûüþ¦™š›œŸ"

    UniChars = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, _
    7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 243, 242, 7887, _
    245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 237, 236, 7881, _
    297, 7883, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, _
    7925, 273, 258, 194, 202, 212, 416, 431, 272)
    For r = 1 To Len(seaChars) Step 1
        Dic(Mid(seaChars, r, 1)) = ChrW$(UniChars(r - 1))
    Next
End If
For r = 1 To Len(strTcvn) Step 1
    If Dic.exists(Mid(strTcvn, r, 1)) Then Mid(strTcvn, r, 1) = Dic(Mid(strTcvn, r, 1))
Next
Vietsea2Unicode = strTcvn
End Function

Tạm ổn một xíu, một vài chữ chưa đúng lắm bạn xem lại thử nhé.
p/s: Mình lấy font trên internet nên kg chắc lắm, mình tra thì không tìm thấy Ư và Ơ do vậy đang mượn tạm ký tự nên chuyển mã nó bị xấu.

 

[vanlethanh]

Public Function Vietsea2Unicode(ByVal strTcvn As String) As String
Static Dic As Object
Dim seaChars As String, UniChars, r As Long
If Dic Is Nothing Then
    Set Dic = CreateObject("Scripting.Dictionary")
    'tcvnChars = "¸µ¶·¹¨¾»¼½Æ©ÊÇÈÉËÐÌÎÏѪÕÒÓÔÖãßáâä«èåæçé¬íêëìîÝ×ØÜÞóïñòôøõö÷ùýúûüþ®¡¢£¤¥¦§"
      seaChars = "ª§¨©« ¯¬®µ¡½¶·¸¾ÐÆÇÏÑ¢ÕÒÓÔÖãßáâä£èåæçé¤íêëìîÝ×ØÜÞóïñòô¥øõö÷ùýúûüþ¦™š›œŸ"

    UniChars = Array(225, 224, 7843, 227, 7841, 259, 7855, 7857, 7859, 7861, 7863, 226, 7845, 7847, _
    7849, 7851, 7853, 233, 232, 7867, 7869, 7865, 234, 7871, 7873, 7875, 7877, 7879, 243, 242, 7887, _
    245, 7885, 244, 7889, 7891, 7893, 7895, 7897, 417, 7899, 7901, 7903, 7905, 7907, 237, 236, 7881, _
    297, 7883, 250, 249, 7911, 361, 7909, 432, 7913, 7915, 7917, 7919, 7921, 253, 7923, 7927, 7929, _
    7925, 273, 258, 194, 202, 212, 416, 431, 272)
    For r = 1 To Len(seaChars) Step 1
        Dic(Mid(seaChars, r, 1)) = ChrW$(UniChars(r - 1))
    Next
End If
For r = 1 To Len(strTcvn) Step 1
    If Dic.exists(Mid(strTcvn, r, 1)) Then Mid(strTcvn, r, 1) = Dic(Mid(strTcvn, r, 1))
Next
Vietsea2Unicode = strTcvn
End Function

Tạm ổn một xíu, một vài chữ chưa đúng lắm bạn xem lại thử nhé.
p/s: Mình lấy font trên internet nên kg chắc lắm, mình tra thì không tìm thấy Ư và Ơ do vậy đang mượn tạm ký tự nên chuyển mã nó bị xấu.

Cám ơn bạn nhiều lắm. Chuyển thành công 99% rồi, còn lại mình sẽ dò và chỉnh lại. Không có bạn hỗ trợ ngồi gõ lại hết chắc chết mất. May quá là may. Cám ơn bạn nhiều nhiều

 

[VetMini]

Cám ơn bạn nhiều lắm. Chuyển thành công 99% rồi, còn lại mình sẽ dò và chỉnh lại. Không có bạn hỗ trợ ngồi gõ lại hết chắc chết mất. May quá là may. Cám ơn bạn nhiều nhiều

Cám ơn nhiều nhiều mà có sẵn lòng đãi người ta bữa phở chăng?
Nếu có thì đóng 100k vào đây:

[KHẨN] HƯỚNG VỀ ĐỒNG BÀO CHỊU ẢNH HƯỞNG CỦA BÃO YAGI - BẢO YÊN, LÀO CAI

KÊU GỌI QUYÊN GÓP CÙNG HƯỚNG VỀ NHỮNG GIA ĐÌNH BỊ ẢNH HƯỞNG BỞI LŨ LỤT SAU BÃO SỐ 3 YAGI TẠI HUYỆN BẢO YÊN – LÀO CAI Kính gửi thành viên diễn đàn GIẢI PHÁP EXCEL.COM, Miền Bắc nước ta vừa trải qua một cơn bão lịch sử – bão số 3 Yagi đã gây ra những thiệt hại nặng nề cho nhiều vùng miền, đặc...

www.giaiphapexcel.com