Chuyển font TCVN3 sang font Unicode

Function TCVN3toUNICODE(vnstr As String)
Dim c As String, i As Integer
   For i = 1 To Len(vnstr)
      c = Mid(vnstr, i, 1)
      Select Case c
         Case "a": c = ChrW$(97)
         Case "¸": c = ChrW$(225)
         Case "µ": c = ChrW$(224)
         Case "¶": c = ChrW$(7843)
         Case "·": c = ChrW$(227)
         Case "¹": c = ChrW$(7841)
         Case "¨": c = ChrW$(259)
         Case "¾": c = ChrW$(7855)
         Case "»": c = ChrW$(7857)
         Case "¼": c = ChrW$(7859)
         Case "½": c = ChrW$(7861)
         Case "Æ": c = ChrW$(7863)
         Case "©": c = ChrW$(226)
         Case "Ê": c = ChrW$(7845)
         Case "Ç": c = ChrW$(7847)
         Case "È": c = ChrW$(7849)
         Case "É": c = ChrW$(7851)
         Case "Ë": c = ChrW$(7853)
         Case "e": c = ChrW$(101)
         Case "Ð": c = ChrW$(233)
         Case "Ì": c = ChrW$(232)
         Case "Î": c = ChrW$(7867)
         Case "Ï": c = ChrW$(7869)
         Case "Ñ": c = ChrW$(7865)
         Case "ª": c = ChrW$(234)
         Case "Õ": c = ChrW$(7871)
         Case "Ò": c = ChrW$(7873)
         Case "Ó": c = ChrW$(7875)
         Case "Ô": c = ChrW$(7877)
         Case "Ö": c = ChrW$(7879)
         Case "o": c = ChrW$(111)
         Case "ã": c = ChrW$(243)
         Case "ß": c = ChrW$(242)
         Case "á": c = ChrW$(7887)
         Case "â": c = ChrW$(245)
         Case "ä": c = ChrW$(7885)
         Case "«": c = ChrW$(244)
         Case "è": c = ChrW$(7889)
         Case "å": c = ChrW$(7891)
         Case "æ": c = ChrW$(7893)
         Case "ç": c = ChrW$(7895)
         Case "é": c = ChrW$(7897)
         Case "¬": c = ChrW$(417)
         Case "í": c = ChrW$(7899)
         Case "ê": c = ChrW$(7901)
         Case "ë": c = ChrW$(7903)
         Case "ì": c = ChrW$(7905)
         Case "î": c = ChrW$(7907)
         Case "i": c = ChrW$(105)
         Case "Ý": c = ChrW$(237)
         Case "×": c = ChrW$(236)
         Case "Ø": c = ChrW$(7881)
         Case "Ü": c = ChrW$(297)
         Case "Þ": c = ChrW$(7883)
         Case "u": c = ChrW$(117)
         Case "ó": c = ChrW$(250)
         Case "ï": c = ChrW$(249)
         Case "ñ": c = ChrW$(7911)
         Case "ò": c = ChrW$(361)
         Case "ô": c = ChrW$(7909)
         Case "­": c = ChrW$(432)
         Case "ø": c = ChrW$(7913)
         Case "õ": c = ChrW$(7915)
         Case "ö": c = ChrW$(7917)
         Case "÷": c = ChrW$(7919)
         Case "ù": c = ChrW$(7921)
         Case "y": c = ChrW$(121)
         Case "ý": c = ChrW$(253)
         Case "ú": c = ChrW$(7923)
         Case "û": c = ChrW$(7927)
         Case "ü": c = ChrW$(7929)
         Case "þ": c = ChrW$(7925)
         Case "®": c = ChrW$(273)
         Case "A": c = ChrW$(65)
         Case "¡": c = ChrW$(258)
         Case "¢": c = ChrW$(194)
         Case "E": c = ChrW$(69)
         Case "£": c = ChrW$(202)
         Case "O": c = ChrW$(79)
         Case "¤": c = ChrW$(212)
         Case "¥": c = ChrW$(416)
         Case "I": c = ChrW$(73)
         Case "U": c = ChrW$(85)
         Case "¦": c = ChrW$(431)
         Case "Y": c = ChrW$(89)
         Case "§": c = ChrW$(272)
      End Select
      TCVN3toUNICODE = TCVN3toUNICODE + c
   Next i
End Function

Chuyển font VNI sang font Unicode

Public Function VniToUni(str$) As String
    Dim VNI$, UNI$, i&, sUni$, arrUNI() As String
    VNI = "aù,aø,aû,aõ,aï,aâ,aê,aá,aà,aå,aã,aä,aé,aè,aú,aü,aë,AÙ,AØ,AÛ,AÕ,AÏ,AÂ,AÊ,AÁ,AÀ,AÅ,AÃ,AÄ,AÉ,AÈ,AÚ,AÜ,AË,eù,eø,eû,eõ,eï,eâ,eá,eà,eå,eã,eä,EÙ,EØ,EÛ,EÕ,EÏ,EÂ,EÁ,EÀ,EÅ,EÃ,EÄ,í ,ì ,æ ,ó ,ò ,Í ,Ì ,Æ ,Ó ,Ò ,où,oø,oû,oõ,oï,oâ,ô,oá,oà,oå,oã,oä,ôù,ôø,ôû,ôõ,ôï,OÙ,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Õ,Î ,ñ ,Ñ "
    UNI = "E1,E0,1EA3,E3,1EA1,E2,103,1EA5,1EA7,1EA9,1EAB,1EAD,1EAF,1EB1,1EB3,1EB5,1EB7,C1,C0,1EA2,C3,1EA0,C2,102,1EA4,1EA6,1EA8,1EAA,1EAC,1EAE,1EB0,1EB2,1EB4,1EB6,E9,E8,1EBB,1EBD,1EB9,EA,1EBF,1EC1,1EC3,1EC5,1EC7,C9,C8,1EBA,1EBC,1EB8,CA,1EBE,1EC0,1EC2,1EC4,1EC6,ED,EC,1EC9,129,1ECB,CD,CC,1EC8,128,1ECA,F3,F2,1ECF,F5,1ECD,F4,1A1,1ED1,1ED3,1ED5,1ED7,1ED9,1EDB,1EDD,1EDF,1EE1,1EE3,D3,D2,1ECE,D5,1ECC,D4,1A0,1ED0,1ED2,1ED4,1ED6,1ED8,1EDA,1EDC,1EDE,1EE0,1EE2,FA,F9,1EE7,169,1EE5,1B0,1EE9,1EEB,1EED,1EEF,1EF1,DA,D9,1EE6,168,1EE4,1AF,1EE8,1EEA,1EEC,1EEE,1EF0,FD,1EF3,1EF7,1EF9,1EF5,DD,1EF2,1EF6,1EF8,1EF4,111,110"
    arrUNI = Split(UNI, ",")
     For i = 1 To Len(str)
            If InStr(VNI, Mid(str, i, 2)) > 0 And Len(Mid(str, i, 2)) = 2 Then
                sUni = sUni & ChrW("&h" & arrUNI(InStr(VNI, Mid(str, i, 2)) \ 3))
                 i = i + 1
            ElseIf InStr(VNI, Mid(str, i, 1) & " ") > 0 Then
                sUni = sUni & ChrW("&h" & arrUNI(InStr(VNI, Mid(str, i, 1) & " ") \ 3))
            End If
        If InStr(VNI, Mid(str, i, 1)) = 0 Or InStr("a,A,e,E,o,O,u,U,y,Y, ", Mid(str, i, 1)) > 0 Then sUni = sUni & Mid(str, i, 1)
    Next
    VniToUni = sUni
End Function

Hàm chuyển đổi font TCVN3 hoặc VNI về Unicode
 

Sub ChuyenFontUnicode()
  Dim FontRange As Range, FontName As String, FontSize As String
  FontName = "Time New Roman" 'Tuy chon Font Unicode
  Application.ScreenUpdating = False
  On Error Resume Next
  For Each FontRange In ActiveSheet.UsedRange
    With FontRange
      If UCase(Left(.Font.Name, 3)) = ".VN" Then
        .Value = TCVN3toUNICODE(.Text)
        .Font.Name = FontName
      ElseIf UCase(Left(.Font.Name, 3)) = "VNI" Then
        .Value = VniToUni(.Text)
        .Font.Name = FontName
        .Font.Size = FontSize
      End If
    End With
  Next
  Application.ScreenUpdating = True
  Set FontRange = Nothing
End Sub