Chuyển chữ sang bảng mã unicode

[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.