Bạn thử cấu trúc sau xem sao nhé:
Public Declare Function MessageBox Lib "user32.dll" Alias "MessageBoxW" (ByVal hWnd As Long, ByVal lpText As Long, ByVal lpCaption As Long, ByVal wType As Long) As Long
Public Const cTg = ""
Public Const cHd = "Vui lßng nhÊn tæ hîp phÝm [Ctrl+q] ®Ó thùc hiÖn chuyÓn font sang m· Unicode (Times New Roman)"
Public Const cPrg = "ChuyÓn m·/font sang Unicode (01.01.01)"
'Public Const cPrg = "Chuyeån maõ font sang Unicode (Rev.01-10.09)"
Sub ChuyenFont() 'Ctrl+q
TenBang = ActiveSheet.Name
For Each sh In Worksheets
Bang = sh.Name
TtSh = Sheets(Bang).Visible
Sheets(Bang).Visible = -1
Sheets(Bang).Select
ActiveSheet.Unprotect
Hg = ActiveCell.SpecialCells(xlLastCell).Row
Cot = ActiveCell.SpecialCells(xlLastCell).Column
ThucHienChuyenFont Hg, Cot
Sheets(Bang).Visible = TtSh
Next sh
Sheets(TenBang).Select
Application.StatusBar = FTcvUni(cTg & " - " & cHd)
End Sub
Sub ThucHienChuyenFont(Hg, Cot)
On Error Resume Next
cDgTb = FTcvUni("Ch¬ng tr×nh thùc hiÖn chuyÓn font trªn Sheet: " & ActiveSheet.Name & ", ®¹t: ")
For H = 1 To Hg
For C = 1 To Cot
cValue = Cells(H, C).Formula
If Len(cValue) = 0 Then GoTo BoQua
cFont = Cells(H, C).Font.Name
Select Case Left(cFont, 3)
Case ".Vn":
cValueUni = FTcvUni(cValue)
If UCase(Right(cFont, 1)) = "H" Then cValueUni = FUniThgHoa(cValueUni, 0) 'Chuyen sang chu hoa
Case "VNI": cValueUni = FVniUni(cValue)
Case Else: cValueUni = cValue
End Select
If cValueUni <> cValue Then
Cells(H, C) = cValueUni
Cells(H, C).Font.Name = "Times New Roman"
End If
BoQua:
Next C
Application.StatusBar = cDgTb & Format(H / Hg * 100, "0.0") & " %"
Next H
Cells.Font.Name = "Times New Roman"
End Sub
Function FTcvUni(Cch)
'Copy tu file chuyen ma tren excel
'Cch: chuoi co ma font chu TCVN3-ABC chuyen qua Unicode
If IsNull(Cch) Then
FTcvUni = ""
Exit Function
End If
Cch2 = ""
For k = 1 To Len(Cch)
Ktu = Mid(Cch, k, 1)
MaAbc = Asc(Ktu)
Select Case MaAbc
Case 221, 227: MaUni = MaAbc + 16
Case 223, 226: MaUni = MaAbc + 19
Case 201, 203: MaUni = MaAbc + 7650
Case 185, 209: MaUni = MaAbc + 7656
Case 228, 232: MaUni = MaAbc + 7657
Case 182, 206, 222: MaUni = MaAbc + 7661
Case 207, 225, 229, 237: MaUni = MaAbc + 7662
Case 210, 230: MaUni = MaAbc + 7663
Case 211, 231, 233: MaUni = MaAbc + 7664
Case 190, 198, 212, 214, 216, 244, 248: MaUni = MaAbc + 7665
Case 236, 238: MaUni = MaAbc + 7669
Case 187, 241, 245: MaUni = MaAbc + 7670
Case 188, 246, 254: MaUni = MaAbc + 7671
Case 189, 247, 249: MaUni = MaAbc + 7672
Case 243: MaUni = 250
Case 239: MaUni = 249
Case 215: MaUni = 236
Case 208: MaUni = 233
Case 204: MaUni = 232
Case 162: MaUni = 194
Case 163: MaUni = 202
Case 184: MaUni = 225
Case 181: MaUni = 224
Case 183: MaUni = 227
Case 164: MaUni = 212
Case 169: MaUni = 226
Case 170: MaUni = 234
Case 171: MaUni = 244
Case 220: MaUni = 297
Case 161: MaUni = 258
Case 165: MaUni = 416
Case 166: MaUni = 431
Case 167: MaUni = 272
Case 168: MaUni = 259
Case 172: MaUni = 417
Case 173: MaUni = 432
Case 174: MaUni = 273
Case 199: MaUni = 7847
Case 200: MaUni = 7849
Case 202: MaUni = 7845
Case 213: MaUni = 7871
Case 234: MaUni = 7901
Case 235: MaUni = 7903
Case 242: MaUni = 361
Case 250: MaUni = 7923
Case 251: MaUni = 7927
Case 252: MaUni = 7929
Case Else: MaUni = MaAbc
End Select
Cch2 = Cch2 & ChrW(MaUni)
Next k
FTcvUni = Cch2
End Function
Function FVniUni(Cch)
Dim C As String, i As Integer
Dim db As Boolean
For i = 1 To Len(Cch)
db = False
If i < Len(Cch) Then
C = Mid(Cch, i + 1, 1)
If C = "ù" Or C = "ø" Or C = "û" Or C = "õ" Or C = "ï" Or _
C = "ê" Or C = "é" Or C = "è" Or C = "ú" Or C = "ü" Or C = "ë" Or _
C = "â" Or C = "á" Or C = "à" Or C = "å" Or C = "ã" Or C = "ä" Or _
C = "Ù" Or C = "Ø" Or C = "Û" Or C = "Õ" Or C = "Ï" Or _
C = "Ê" Or C = "É" Or C = "È" Or C = "Ú" Or C = "Ü" Or C = "Ë" Or _
C = "Â" Or C = "Á" Or C = "À" Or C = "Å" Or C = "Ã" Or C = "Ä" Then db = True
End If
If db Then '2 ky tu lien tuc
C = Mid(Cch, i, 2)
Select Case C
Case "aù": C = ChrW$(225)
Case "aø": C = ChrW$(224)
Case "aû": C = ChrW$(7843)
Case "aõ": C = ChrW$(227)
Case "aï": C = ChrW$(7841)
Case "aê": C = ChrW$(259)
Case "aé": C = ChrW$(7855)
Case "aè": C = ChrW$(7857)
Case "aú": C = ChrW$(7859)
Case "aü": C = ChrW$(7861)
Case "aë": C = ChrW$(7863)
Case "aâ": C = ChrW$(226)
Case "aá": C = ChrW$(7845)
Case "aà": C = ChrW$(7847)
Case "aå": C = ChrW$(7849)
Case "aã": C = ChrW$(7851)
Case "aä": C = ChrW$(7853)
Case "eù": C = ChrW$(233)
Case "eø": C = ChrW$(232)
Case "eû": C = ChrW$(7867)
Case "eõ": C = ChrW$(7869)
Case "eï": C = ChrW$(7865)
Case "eâ": C = ChrW$(234)
Case "eá": C = ChrW$(7871)
Case "eà": C = ChrW$(7873)
Case "eå": C = ChrW$(7875)
Case "eã": C = ChrW$(7877)
Case "eä": C = ChrW$(7879)
Case "où": C = ChrW$(243)
Case "oø": C = ChrW$(242)
Case "oû": C = ChrW$(7887)
Case "oõ": C = ChrW$(245)
Case "oï": C = ChrW$(7885)
Case "oâ": C = ChrW$(244)
Case "oá": C = ChrW$(7889)
Case "oà": C = ChrW$(7891)
Case "oå": C = ChrW$(7893)
Case "oã": C = ChrW$(7895)
Case "oä": C = ChrW$(7897)
Case "ôù": C = ChrW$(7899)
Case "ôø": C = ChrW$(7901)
Case "ôû": C = ChrW$(7903)
Case "ôõ": C = ChrW$(7905)
Case "ôï": C = ChrW$(7907)
Case "uù": C = ChrW$(250)
Case "uø": C = ChrW$(249)
Case "uû": C = ChrW$(7911)
Case "uõ": C = ChrW$(361)
Case "uï": C = ChrW$(7909)
Case "öù": C = ChrW$(7913)
Case "öø": C = ChrW$(7915)
Case "öû": C = ChrW$(7917)
Case "öõ": C = ChrW$(7919)
Case "öï": C = ChrW$(7921)
Case "yù": C = ChrW$(253)
Case "yø": C = ChrW$(7923)
Case "yû": C = ChrW$(7927)
Case "yõ": C = ChrW$(7929)
Case "AÙ": C = ChrW$(193)
Case "AØ": C = ChrW$(192)
Case "AÛ": C = ChrW$(7842)
Case "AÕ": C = ChrW$(195)
Case "AÏ": C = ChrW$(7840)
Case "AÊ": C = ChrW$(258)
Case "AÉ": C = ChrW$(7854)
Case "AÈ": C = ChrW$(7856)
Case "AÚ": C = ChrW$(7858)
Case "AÜ": C = ChrW$(7860)
Case "AË": C = ChrW$(7862)
Case "AÂ": C = ChrW$(194)
Case "AÁ": C = ChrW$(7844)
Case "AÀ": C = ChrW$(7846)
Case "AÅ": C = ChrW$(7848)
Case "AÃ": C = ChrW$(7850)
Case "AÄ": C = ChrW$(7852)
Case "EÙ": C = ChrW$(201)
Case "EØ": C = ChrW$(200)
Case "EÛ": C = ChrW$(7866)
Case "EÕ": C = ChrW$(7868)
Case "EÏ": C = ChrW$(7864)
Case "EÂ": C = ChrW$(202)
Case "EÁ": C = ChrW$(7870)
Case "EÀ": C = ChrW$(7872)
Case "EÅ": C = ChrW$(7874)
Case "EÃ": C = ChrW$(7876)
Case "EÄ": C = ChrW$(7878)
Case "OÙ": C = ChrW$(211)
Case "OØ": C = ChrW$(210)
Case "OÛ": C = ChrW$(7886)
Case "OÕ": C = ChrW$(213)
Case "OÏ": C = ChrW$(7884)
Case "OÂ": C = ChrW$(212)
Case "OÁ": C = ChrW$(7888)
Case "OÀ": C = ChrW$(7890)
Case "OÅ": C = ChrW$(7892)
Case "OÃ": C = ChrW$(7894)
Case "OÄ": C = ChrW$(7896)
Case "ÔÙ": C = ChrW$(7898)
Case "ÔØ": C = ChrW$(7900)
Case "ÔÛ": C = ChrW$(7902)
Case "ÔÕ": C = ChrW$(7904)
Case "ÔÏ": C = ChrW$(7906)
Case "UÙ": C = ChrW$(218)
Case "UØ": C = ChrW$(217)
Case "UÛ": C = ChrW$(7910)
Case "UÕ": C = ChrW$(360)
Case "UÏ": C = ChrW$(7908)
Case "ÖÙ": C = ChrW$(7912)
Case "ÖØ": C = ChrW$(7914)
Case "ÖÛ": C = ChrW$(7916)
Case "ÖÕ": C = ChrW$(7918)
Case "ÖÏ": C = ChrW$(7920)
Case "YÙ": C = ChrW$(221)
Case "YØ": C = ChrW$(7922)
Case "YÛ": C = ChrW$(7926)
Case "YÕ": C = ChrW$(7928)
End Select
Else
C = Mid(Cch, i, 1) '1 ky tu
Select Case C
Case "ô": C = ChrW$(417)
Case "í": C = ChrW$(237)
Case "ì": C = ChrW$(236)
Case "æ": C = ChrW$(7881)
Case "ó": C = ChrW$(297)
Case "ò": C = ChrW$(7883)
Case "ö": C = ChrW$(432)
Case "î": C = ChrW$(7925)
Case "ñ": C = ChrW$(273)
Case "Ô": C = ChrW$(416)
Case "Í": C = ChrW$(205)
Case "Ì": C = ChrW$(204)
Case "Æ": C = ChrW$(7880)
Case "Ó": C = ChrW$(296)
Case "Ò": C = ChrW$(7882)
Case "Ö": C = ChrW$(431)
Case "Î": C = ChrW$(7924)
Case "Ñ": C = ChrW$(272)
End Select
End If
FVniUni = FVniUni + C
If db Then i = i + 1
Next i
End Function
Function FUniThgHoa(Cch1, Sco1)
'Cch1: chuoi font UNICODE
FUniThgHoa = ""
If Trim(Cch1) = "" Then Exit Function
Cch2 = ""
Select Case Sco1
Case 0 'Chuyen ca chuoi
For k = 1 To Len(Cch1)
KtThg = Mid(Cch1, k, 1)
Cch2 = Cch2 & FUniHoa1Kt(KtThg)
Next k
Case 1 '1 ky tu dau
KtThg = Left(Cch1, 1)
Cch2 = Right(Cch1, Len(Cch1) - 1)
Cch2 = FUniHoa1Kt(KtThg) & Cch2
Case 2 'ky tu dau tu (ten rieng)
Cch1 = " " & Cch1
For k = Len(Cch1) To 2 Step -1
KtThg = Mid(Cch1, k, 1)
KtTrg = Mid(Cch1, k - 1, 1)
If KtTrg = " " Then
Cch2 = FUniHoa1Kt(KtThg) & Cch2
Else
Cch2 = KtThg & Cch2
End If
Next k
End Select
FUniThgHoa = Cch2
End Function
Function FUniHoa1Kt(KtThg)
MaAscWt = AscW(KtThg)
Select Case MaAscWt
Case 97 To 122 'a-z
KtHoa = ChrW(MaAscWt - 32)
Case 224 To 227, 232 To 234, 236, 237, 242 To 245, 249, 250, 253
KtHoa = ChrW(MaAscWt - 32)
Case 259, 273, 297, 361, 417, 432
KtHoa = ChrW(MaAscWt - 1)
Case 7841 To 7929
KtHoa = ChrW(MaAscWt - (MaAscWt Mod 2))
Case Else: KtHoa = KtThg
End Select
FUniHoa1Kt = KtHoa
End Function
Function FMsgUni(ByVal Chuoi As String, Optional Bieutuong As VbMsgBoxStyle = 64, _
Optional ByVal Tieude As String = cPrg, _
Optional ByVal Khac As Long = 0) As VbMsgBoxResult
FMsgUni = MessageBox(Khac, StrPtr(Chuoi), StrPtr(Tieude), Bieutuong)
End Function
