Cần giúp viết Code Lưu tên File mới trùng với tên và đường dẫn đã lưu của File đã xóa (1 người xem)

[hung2412]

Xin chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một quy trình:
- Bước 1: Tôi đang làm việc trên 1 File Excel.
- Bước 2: Tôi mở 1 File mới và tách hẳn ra cái File Excel đang chạy.
- Bước 3: Cut and Paste toàn bộ dữ liệu từ File đang làm việc sang File mới.
- Bước 4: Save, close và Delete File đang làm việc vào thùng rác.
- Bước 5: Save và close tên File mới đó trùng với tên File và đường dẫn đã lưu trước khi Deletecủa File đã xóa vào thùng rác.
- Bước 6: Mở (Open) lại File mới đó.
- Bước 7: Chạy Code Convert từ Font VnTime sang Font Time New Roman (Code này rất dài nên tôi không tiện post lên)
Toàn bộ quy trình trên mục đích là để chữa lỗi Font bị "?" của bài viết này http://www.giaiphapexcel.com/forum/...g-(Excel-2007-bị-lỗi-Excel-2003-không-bị-lỗi) (Khi sử dụng Code Convert từ Font VnTime sang Font Time New Roman).
Có Code nào làm được tất cả các bước (Từ Bước 1 đến bước 6) như trên hay không?
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Bổ sung thêm 01 File đính kèm (File Excel nguyên bản khi chiết từ phần mềm kế toán).

 

[Kiều Mạnh]

làm gì mà phải tự hành mình cực như vậy ko biết

 

[hung2412]

làm gì mà phải tự hành mình cực như vậy ko biết

Như #1 tôi đã nói rồi mà => Để chữa lỗi Font bị "?" bạn ạ.

 

[mhung12005]

Xin chào các bạn GPE!
Nhờ các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tôi có một quy trình:
- Bước 1: Tôi đang làm việc trên 1 File Excel.
- Bước 2: Tôi mở 1 File mới và tách hẳn ra cái File Excel đang chạy.
- Bước 3: Cut and Paste toàn bộ dữ liệu từ File đang làm việc sang File mới.
- Bước 4: Save, close và Delete File đang làm việc vào thùng rác.
- Bước 5: Save và close tên File mới đó trùng với tên File và đường dẫn đã lưu trước khi Deletecủa File đã xóa vào thùng rác.
- Bước 6: Mở (Open) lại File mới đó.
- Bước 7: Chạy Code Convert từ Font VnTime sang Font Time New Roman (Code này rất dài nên tôi không tiện post lên)
Toàn bộ quy trình trên mục đích là để chữa lỗi Font bị "?" của bài viết này http://www.giaiphapexcel.com/forum/...g-(Excel-2007-bị-lỗi-Excel-2003-không-bị-lỗi) (Khi sử dụng Code Convert từ Font VnTime sang Font Time New Roman).
Có Code nào làm được tất cả các bước (Từ Bước 1 đến bước 6) như trên hay không?
Mong các bạn GPE chỉ giáo!
Trân trọng cảm ơn!

Bạn đưa file nguyên dạng khi xuất ra từ phần mềm lên xem sao nhé.

 

[hung2412]

Bạn đưa file nguyên dạng khi xuất ra từ phần mềm lên xem sao nhé.

Đây bạn ơi (File nguyên bản khi xuất từ phần mềm kế toán).
P/s: Đã Up File ở #1.

 

[mhung12005]

Đây bạn ơi (File nguyên bản khi xuất từ phần mềm kế toán).
P/s: Đã Up File ở #1.

Phần mềm xuất ra là mã TCVN3, bạn có thể dùng UniKey để chuyển sang Unicode rất đơn giản.

Bạn tham khảo thêm cách làm nhé (trên mạng có rất nhiều).

Mình chuyển thử file bạn vừa gửi ngon luôn .

Nếu bạn thích dùng VBA thì nó có ở đây này:

http://www.giaiphapexcel.com/forum/showthread.php?79043-Hàm-chuyển-đổi-mã-TCVN3-sang-Unicode

 

[Quang_Hải]

...................................................................................................................................................

 

[phihndhsp]

Mình đọc và nhận thấy rằng hình như từ bước 1 đến bước 6 đâu có làm thay đổi được gì trên file gốc đâu.
Có nhầm lẫn hay thiếu gì chăng?

có thay đổi đó anh, nếu file gốc không cho chỉnh sửa hay làm gì đó đó, chủ topic muốn copy qua file mới để tiện chỉnh sửa đó mà, mà tác giả thích code kiết cho sum tụ thôi

 

[phihndhsp]

Mà tại sao phải nhất thiết code chứ, em thấy tất cả những file mà chủ topic đưa ra toàn muồn là code, mấy tháng rồi ít nhiều gì cũng tư duy ra được nhiều, nhưng những bài gần đây dù đơn giản hay phức tạp chủ topic cũng nhờ viết dùm???? Có những bài gần đây, nói thật rất đơn giản hơn nhiều nhưng chủ topic vẫn nhờ viết code??? Không biết chủ topic muốn thử anh em hay gì gì đó hay sao đó

 

[VetMini]

...??? Không biết chủ topic muốn thử anh em hay gì gì đó hay sao đó

Điều này không quan trọng. Tôi nghĩ mọi người đều biết, chẳng qua mọi người ngứa tay viết code chơi. Và chính chủ thớt cũng rõ luôn. Rốt cuộc lại hai bên đều có lợi.

Điều tôi không rõ là những thành viên ngoài cuộc có lợi gì? Những bài này người ngoài chả ai học được gì cả.

 

[dhn46]

Như #1 tôi đã nói rồi mà => Để chữa lỗi Font bị "?" bạn ạ.

Tôi cũng đã đọc qua bài hỏi về trường hợp của chủ Topic về dấu ?, nhưng đang suy luận như sau:

Chủ Topic Save File sang file mới sau đó Convert thì OK, Convert file cũ trực tiếp nhỉ NG => Điều gì xảy ra?

Cùng Excel 2007, chủ topic dùng cùng 1 loại Code mà ra 2 kết quả đối lập, hơn nữa File đưa lên tôi kiểm tra hoàn toàn là mã chuẩn TCVN3.

Vậy nguyên nhân chính là gì? Có phải quy trình convert của chủ Topic có vấn đề?

Thường thì theo thói quen tập tành code của tôi: tôi sẽ đi tìm nguyên nhân chủ yếu chứ không tìm cách giải quyết tạm thời, bởi giải quyết tạm thời sẽ phát sinh lỗi sau này không kiểm soát được

 

[Quang_Hải]

...................................................................................................................................................

 

[VetMini]

...
Thường thì theo thói quen tập tành code của tôi: tôi sẽ đi tìm nguyên nhân chủ yếu chứ không tìm cách giải quyết tạm thời, bởi giải quyết tạm thời sẽ phát sinh lỗi sau này không kiểm soát được

Đó là câu hỏi của tôi "người ngoài cuộc được gì?"
Chủ thớt không hề hỏi về cách làm việc. Câu hỏi của chủ thớt là "mình muốn..."
Những code cho các đề tài như thế này chỉ là mì ăn liền, giải quyết tại chỗ. "Lỗi sau này" không phải là vấn đề của người hỏi.

Tôi đi làm gặp trường hợp này thường lắm. Khi phát hiện lỗi thì người khởi đầu đã chuyển khâu khác, chuyển công ong ty, hay thậm chí lên sếp rồi. Chỉ có người ở lại chịu.

 

[Hau151978]

Mình mở file bằng excel 2013, convert bằng unikey hoặc addin A-tools của bác Tuân đều bình thường, không bị lỗi font. Không biết tại sao tác giả lại bị lỗi. Có khả năng: tác giả chuyển font bằng code tự tạo và code bị lỗi; office hoặc unikey của tác giả bị lỗi (kiểm tra file ở máy khác sẽ biết).

 

[hung2412]

Tôi xin nói rõ quy trình tôi làm như thế này:
- Mở File 66.xls ở #1.
- Nó hiện ra Hộp thoại là File error: data may have been lost => Kệ nó (Chả việc gì) => Nhấn OK
- Chạy Code Convert từ Font nguồn (VnTime) sang Font Time New Roman:

Option Explicit
PublicDeclare 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()
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

- Sau khi chạy Code xong => Close File 66.xls => Mở lại File 66.xls => Bị lỗi Font "?" => Để khắc phục lỗi Font bị "?" => Tôi làm các bước như #1 (Từ bước 1 đến bước 7) => Vì thế nên tôi nhờ các bạn trên diễn đàn viết giúp Code từ bước 1 đến bước 6.
=> Mời các bạn thử làm các thao tác như trên rồi cho tôi ý kiến với.

 

[mhung12005]

Tôi xin nói rõ quy trình tôi làm như thế này:
- Mở File 66.xls ở #1.
- Nó hiện ra Hộp thoại là File error: data may have been lost => Kệ nó (Chả việc gì) => Nhấn OK
- Chạy Code Convert từ Font nguồn (VnTime) sang Font Time New Roman:

Option Explicit
PublicDeclare 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()
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

- Sau khi chạy Code xong => Close File 66.xls => Mở lại File 66.xls => Bị lỗi Font "?" => Để khắc phục lỗi Font bị "?" => Tôi làm các bước như #1 (Từ bước 1 đến bước 7) => Vì thế nên tôi nhờ các bạn trên diễn đàn viết giúp Code từ bước 1 đến bước 6.
=> Mời các bạn thử làm các thao tác như trên rồi cho tôi ý kiến với.

Bạn đưa cả rừng code thế này chắc chẳng mấy ai đọc đâu.

Theo mình hiểu thì bạn muốn convert từ mã TCVN3 sang Unicode (đoạn text trong sheet1 file 66) để khi hiển thị trên font Times New Roman không bị lỗi bằng VBA đúng không ?

Nếu đúng thì bạn bỏ cái quy trình dài dòng mà hiệu quả thấp đang làm kia đi và xem file đính kèm.

Mình áp dụng hàm Covert của bác Swim viết vào bài của bạn.

Việc còn lại của bạn là copy dữ liệu từ file đc xuất ra từ phần mềm paste vào sheet1 --> sang sheet2 nhấn nút convert --> xem kq.

 

[Quang_Hải]

...................................................................................................................................................

 

[hung2412]

Việc còn lại của bạn là copy dữ liệu từ file đc xuất ra từ phần mềm paste vào sheet1 --> sang sheet2 nhấn nút convert --> xem kq.

Tôi xài Excel 2003 bạn ạ. Tôi kích vào nút Convert không có tác dụng bạn ơi.

 

[hung2412]

Tôi cũng đã đọc qua bài hỏi về trường hợp của chủ Topic về dấu ?, nhưng đang suy luận như sau:

Chủ Topic Save File sang file mới sau đó Convert thì OK, Convert file cũ trực tiếp nhỉ NG => Điều gì xảy ra?

Cùng Excel 2007, chủ topic dùng cùng 1 loại Code mà ra 2 kết quả đối lập, hơn nữa File đưa lên tôi kiểm tra hoàn toàn là mã chuẩn TCVN3.

Vậy nguyên nhân chính là gì? Có phải quy trình convert của chủ Topic có vấn đề?

Thường thì theo thói quen tập tành code của tôi: tôi sẽ đi tìm nguyên nhân chủ yếu chứ không tìm cách giải quyết tạm thời, bởi giải quyết tạm thời sẽ phát sinh lỗi sau này không kiểm soát được

Bạn thử làm các thao tác như #15 thử xem sao bạn.

 

[mhung12005]

Tôi xài Excel 2003 bạn ạ. Tôi kích vào nút Convert không có tác dụng bạn ơi.

Mình đổi sang Excel 2003 rồi bạn nhé.

 

[hung2412]

Mình đổi sang Excel 2003 rồi bạn nhé.

Cảm ơn bạn nhiều, xin lỗi đã làm phiền bạn. Mong bạn nói rõ hơn là bạn làm như thế nào vậy?
Ví dụ bây giờ tôi chiết từ phần mềm kế toán ra Excel và đặt tên là Sổ chi tiết. Tôi muốn chạy Code Convert của bạn trực tiếp luôn (Giống như bạn làm với File 66.xls ý) (Tức là không cần phải Cut and Paste từ File tên là Sổ chi tiết vô File 66.xls rồi sang Sheet2 của File 66.xls để bấm nút Convert nữa).

 

[mhung12005]

Cảm ơn bạn nhiều, xin lỗi đã làm phiền bạn. Mong bạn nói rõ hơn là bạn làm như thế nào vậy?
Ví dụ bây giờ tôi chiết từ phần mềm kế toán ra Excel và đặt tên là Sổ chi tiết. Tôi muốn chạy Code Convert của bạn trực tiếp luôn (Giống như bạn làm với File 66.xls ý) (Tức là không cần phải Cut and Paste từ File tên là Sổ chi tiết vô File 66.xls rồi sang Sheet2 của File 66.xls để bấm nút Convert nữa).

Nếu thế thì bạn phải lưu file chứa code lại thành Add-in mới sử dụng như thế đc bạn ạ. Bạn tham khảo về Add-in trong excel nhé (cũng không khó đâu) trên diễn đàn có rất nhiều

 

[hung2412]

Mà tại sao phải nhất thiết code chứ, em thấy tất cả những file mà chủ topic đưa ra toàn muồn là code, mấy tháng rồi ít nhiều gì cũng tư duy ra được nhiều, nhưng những bài gần đây dù đơn giản hay phức tạp chủ topic cũng nhờ viết dùm???? Có những bài gần đây, nói thật rất đơn giản hơn nhiều nhưng chủ topic vẫn nhờ viết code??? Không biết chủ topic muốn thử anh em hay gì gì đó hay sao đó

Tôi muốn học hỏi thêm thôi mà. Đối với bạn thì đơn giản nhưng đối với tôi thì cả một vấn đề. Không lẽ không được hay sao?

 

[VetMini]

Tôi muốn học hỏi thêm thôi mà. Đối với bạn thì đơn giản nhưng đối với tôi thì cả một vấn đề. Không lẽ không được hay sao?

Bạn thì muốn học hỏi thêm, các bạn viết code thì muốn rèn luyện tay nghề code của mình. Tốt thôi.

Bạn phihndhsp chỉ nhắc nhở cho các bạn cũng cần học khác rằng các vấn đề này dùng code là bày vẽ mất công. Cũng tốt thôi.