Cần giúp đỡ chuyển mã font nguồn thành font Time new roman

Liên hệ QC

hung2412

Thành viên tích cực
Tham gia
5/8/08
Bài viết
905
Được thích
239
Giới tính
Nam
Mình chào các bạn GPE!
Mình có một vấn đề cần sự giúp đỡ của các bạn, cụ thể như sau: Mình có một file excel cần chuyển sang font Time new roman bằng VBA (Mình có phần mềm chuyển font rồi nhưng mình muốn chuyển font bằng VBA để chạy trực tiếp không cần phần mềm chuyển font khác).
Trân trọng cảm ơn!

P/s: Có file đính kèm
 

File đính kèm

  • TK 6211.xls
    24 KB · Đọc: 68
Mở file ra. Vào cửa sổ Immediate. Gõ dòng này:
for each s in sheets: s.Cells.font.name = "Times New Roman": next s
Nếu muốn giữ thành Sub thì gói dòng ấy giữa 2 dòng Sub ChuyenPhong() và End Sub
 
Mở file ra. Vào cửa sổ Immediate. Gõ dòng này:
for each s in sheets: s.Cells.font.name = "Times New Roman": next s
Nếu muốn giữ thành Sub thì gói dòng ấy giữa 2 dòng Sub ChuyenPhong() và End Sub
Chào bạn, tớ đã làm như theo bạn nói là mở module sub Chuyenfont() và End sub, nhưng nó bắt khai báo biến s, tớ đã thử khai báo biến là dạng variant => Kết quả là chỉ những ô có số và ký tự thì chuyển được, còn những ô chứa chữ thì bị lỗi font không đọc được. Tớ gửi file bạn thử xem xem.
 

File đính kèm

  • TK 6211 (Da chuyen font).xls
    26 KB · Đọc: 14
Hix, không có vị nào ngó ngàng tới đề tài này nhỉ? Không biết là đề tài này có phải là ngớ ngẩn không nữa.+-+-+-+
 
Không có vị cao thủ nào ra tay giúp đỡ cả. @@
 
Tớ từng tìm trên GPE, và làm như sau: vào VBA, tạo 1 module và copy đoạn code như sau, rồi Save, quay ra excel bạn dùng CTRL+Q . Nhớ là nó sẽ chuyển toàn bộ lần lượt từng worksheet một (nhiều sheet sẽ lâu ah).

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

EM KHÔNG NHỚ LÀ ĐOẠN CODE CỦA TÁC GIẢ NÀO NÊN CỨ MẠO MUỘI... MONG ĐƯỢC THÔNG CẢM CỦA TÁC GIÁ Ạ.
 
Lần chỉnh sửa cuối:
Tớ từng tìm trên GPE, và làm như sau: vào VBA, tạo 1 module và copy đoạn code như sau, rồi Save, quay ra excel bạn dùng CTRL+Q . Nhớ là nó sẽ chuyển toàn bộ lần lượt từng worksheet một (nhiều sheet sẽ lâu ah)
....
EM KHÔNG NHỚ LÀ ĐOẠN CODE CỦA TÁC GIẢ NÀO NÊN CỨ MẠO MUỘI... MONG ĐƯỢC THÔNG CẢM CỦA TÁC GIÁ Ạ.
Cái này rất hay, Code này hình như là của tác giả Đỗ Thành Nhân, mình cảm ơn bạn nhiều.
 
Chỉnh sửa lần cuối bởi điều hành viên:
Em xin cám ơn tác giả Đỗ Thành Nhân. em làm ngân hàng hay lọc nhiều mà kiểu chữ times new là nhìn thấy rõ, chứ không loằng ngoằng nên em thấy code ấy thật tuyệt.
 
Bài viết thật hữu ích. Em cảm ơn!
 
New Bitmap Image.jpg
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
 
Lần chỉnh sửa cuối:
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]
 
Mình làm rồi bạn ạ, sau khi bấm nó bội đen toàn bộ các dòng dữ liệu (y như Ctrl+A) vậy sau đó bấm Ctrl+Q như hướng dẫn nó vẫn ra bản format như hình mình gửi kèm lần trước.
Có thể đây là phím tắt của office 2013 và trùng với code nên thế
 
Mình làm rồi bạn ạ, sau khi bấm nó bội đen toàn bộ các dòng dữ liệu (y như Ctrl+A) vậy sau đó bấm Ctrl+Q như hướng dẫn nó vẫn ra bản format như hình mình gửi kèm lần trước.
Có thể đây là phím tắt của office 2013 và trùng với code nên thế
Bạn thử sang máy khác cài office 2003 hoặc 2007 xem sao.
 
Không có cách nào khác hả bác, cơ quan em có 5 cái máy toàn 2013 cả, lại bản quyền nữa.
Ở nhà em cũng cài 2013 bản quyền theo laptop ;;;;;;;;;;;
 
Không có cách nào khác hả bác, cơ quan em có 5 cái máy toàn 2013 cả, lại bản quyền nữa.
Ở nhà em cũng cài 2013 bản quyền theo laptop ;;;;;;;;;;;
Bạn chuyển đổi font (Ctrl + q) thì toàn bị lỗi như ảnh ở trên ah? (Bạn thử sang File Excel khác xem sao)
 
Bạn chuyển đổi font (Ctrl + q) thì toàn bị lỗi như ảnh ở trên ah? (Bạn thử sang File Excel khác xem sao)
Đúng rồi.
Mình mô tả chi tiết nhé.
mở file excel có font lỗi (chỉ để 1 sheet duy nhất, cột A), enable macro cho chạy ở option của excel => bấm atl+F11 để hiển thị VBcode lên => chọn insert\module sau đó paste đoạn code bạn gửi => save lại (sau đó tắt cửa sổ hoặc giữ nguyên đều đã thử) => quay lại sheet có font lỗi:
1. Nếu để trò chuột ở ngoài cột A và bấm ctrl+q => không thấy gì chạy
2. Nếu để trỏ chuột vào dòng bất kỳ trong vùng dữ liệu thì ra hình như ảnh đã gửi bạn.
Đã thử file khác tương tự, mượn được 1 lap có excel 2010 cũng bị vậy

Không biết có sai bước nào không ạ?
 
Đúng rồi.
Mình mô tả chi tiết nhé.
mở file excel có font lỗi (chỉ để 1 sheet duy nhất, cột A), enable macro cho chạy ở option của excel => bấm atl+F11 để hiển thị VBcode lên => chọn insert\module sau đó paste đoạn code bạn gửi => save lại (sau đó tắt cửa sổ hoặc giữ nguyên đều đã thử) => quay lại sheet có font lỗi:
1. Nếu để trò chuột ở ngoài cột A và bấm ctrl+q => không thấy gì chạy
2. Nếu để trỏ chuột vào dòng bất kỳ trong vùng dữ liệu thì ra hình như ảnh đã gửi bạn.
Đã thử file khác tương tự, mượn được 1 lap có excel 2010 cũng bị vậy

Không biết có sai bước nào không ạ?
Bạn thử download File excel ở #1 trên cùng, sau đó chạy code như ở #11 xem có chuyển font được ko?
 
E để file gốc csv thì nó vẫn thế không ra font đẹp, vẫn lằng ngoằng. em đoán do file #1 là .vntimes hay gì đó còn file e đã là unicode sẵn rồi nên không ăn (file all.csv đính kèm)
E chuyển sang *.xlsx thì nó báo lỗi " compile error: Invalid outside procedure"
 

File đính kèm

  • all.zip
    1.1 KB · Đọc: 7
Lần chỉnh sửa cuối:
E để file gốc csv thì nó vẫn thế không ra font đẹp, vẫn lằng ngoằng. em đoán do file #1 là .vntimes hay gì đó còn file e đã là unicode sẵn rồi nên không ăn (file all.csv đính kèm)
E chuyển sang *.xlsx thì nó báo lỗi " compile error: Invalid outside procedure"
Thôi thì thế này, bạn thử download File excel ở #1 trên cùng, sau đó chạy code như ở #11 (Không nhấn Ctrl + q nhé, chạy code bằng cách mở Alt + F11 để mở cửa sổ VBA => Paste code vào => Nhấn F8 cho nó hiện ra mũi tên màu vàng => Nhấn F5 để chạy Code) xem có chuyển font được ko?
 
Chịu rồi bạn ạ
Chúng Tôi Đơn Giản Là GấuQuảng Bình
Phim Truyện Bộ Hà nh Động Vô Gian Đạo - Tập 9/14 - Phần 1Quảng Bình
 
Web KT
Back
Top Bottom