View attachment 172906
Mình làm theo hướng dẫn,ở dưới thanh trạng thái có xuất hiện dòng "vui lòng bấm tổ hợp phím [ctrl +q] để thực hiện chuyển font sang mã Unicode (time new roman)
Sau khi Ctrl+Q nó bôi đen toàn bộ và ra cái định dạng ô như trong hình bạn ạ.
Mình dùng office 2013
Bạn dùng code này (Nhớ ấn tổ hợp phím Ctrl + q nhé)
[GPECODE=vb]
Option Explicit
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)"
Dim TenBang As Variant
Dim sh As Variant
Dim Bang As Variant
Dim TtSh As Variant
Dim Hg As Variant
Dim Cot As Variant
Dim cDgTb As Variant
Dim H As Variant
Dim c As Variant
Dim cValue As Variant
Dim cFont As Variant
Dim cValueUni As Variant
Dim Cch2 As Variant
Dim k As Variant
Dim Ktu As Variant
Dim MaAbc As Variant
Dim MaUni As Variant
Dim KtThg As Variant
Dim KtTrg As Variant
Dim MaAscWt As Variant
Dim KtHoa As Variant
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
[/GPECODE]