- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,963
File của bạn bị hư rồi nên không kiểm tra đượcEm xin được hỏi ra khỏi chủ đề một chút, sao file em thử nghiệm em đặt tên nó là "Test thu" thì nó không chuyển là sao hả thày?
Xem lại nhé
File của bạn bị hư rồi nên không kiểm tra đượcEm xin được hỏi ra khỏi chủ đề một chút, sao file em thử nghiệm em đặt tên nó là "Test thu" thì nó không chuyển là sao hả thày?
File của bạn bị hư rồi nên không kiểm tra được
Xem lại nhé
Code này còn rất nhiều chổ cần bẫy lổi:Đúng là file em gửi kèm vừa rồi giải nén có bị lỗi, em đã gửi lại file khác rồi thày ah. Tuy nhiên, vấn đề mà em muốn đề cập là file em muốn chuyển đổi (cho nằm cùng thư mục với file TCVN3_Unicode cơ ah) em đặt nó tên là Test thu thì nó không chuyển đổi được, nhưng nếu đổi tên cho nó là được ngay.
Em xin gửi kèm file đính kèm minh hoạ.
Sub Open_Close_File()
Dim myPath As String, myFile As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
myPath = ThisWorkbook.Path
With CreateObject("Scripting.FileSystemObject")
For Each myFile In .GetFolder(myPath).Files
If myFile.Path <> ThisWorkbook.FullName And myFile.Type Like "Microsoft Excel*" Then
With Workbooks.Open(myFile.Path)
Call Unicode: .Close (True)
End With
End If
Next
End With
MsgBox "Thành công"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Code này còn rất nhiều chổ cần bẫy lổi:
- Vòng lập duyệt qua các file chắc chắn sẽ lấy luôn file hiện hành ---> Vậy cần phải IF để tránh
- Trong thư mục, nếu có 1 file nào đó không phải Excel, làm sao mà Workbooks.Open được đây?
Tôi sửa lại thế này:
Bạn kiểm tra lại xem thế nào nhéPHP:Sub Open_Close_File() Dim myPath As String, myFile As Object Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next myPath = ThisWorkbook.Path With CreateObject("Scripting.FileSystemObject") For Each myFile In .GetFolder(myPath).Files If myFile.Path <> ThisWorkbook.FullName And myFile.Type Like "Microsoft Excel*" Then With Workbooks.Open(myFile.Path) Call Unicode: .Close (True) End With End If Next End With MsgBox "Thành công" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
--------------
Ngoài ra xin góp ý chút: Đã muốn "dấn thân" vào con đường lập trình thì điều đầu tiên bạn nên học là: KHAI BÁO BIẾN CHO ĐẦY ĐỦ, không được viết theo kiểu tùy tiện!
Làm hết 1 lần hoàn thiện luôn, bạn sẽ chẳng biết đường đâu mà lần (khi có nhu cầu chỉnh sửa)nếu thày có thời gian xin thày và mọi người giúp em hoàn chỉnh file này Code này với ah.
.
Code này còn rất nhiều chổ cần bẫy lổi:
- Vòng lập duyệt qua các file chắc chắn sẽ lấy luôn file hiện hành ---> Vậy cần phải IF để tránh
- Trong thư mục, nếu có 1 file nào đó không phải Excel, làm sao mà Workbooks.Open được đây?
Tôi sửa lại thế này:
Bạn kiểm tra lại xem thế nào nhéPHP:Sub Open_Close_File() Dim myPath As String, myFile As Object Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next myPath = ThisWorkbook.Path With CreateObject("Scripting.FileSystemObject") For Each myFile In .GetFolder(myPath).Files If myFile.Path <> ThisWorkbook.FullName And myFile.Type Like "Microsoft Excel*" Then With Workbooks.Open(myFile.Path) Call Unicode: .Close (True) End With End If Next End With MsgBox "Thành công" Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub
--------------
Ngoài ra xin góp ý chút: Đã muốn "dấn thân" vào con đường lập trình thì điều đầu tiên bạn nên học là: KHAI BÁO BIẾN CHO ĐẦY ĐỦ, không được viết theo kiểu tùy tiện!
Thưa thày Ndu, em thử nghiệm đối với các file cùng trong thư mục thì nó chỉ chuyển Sheet hiện hành đang mở. Mục đích của em là chuyển mã (font) cho tất cả các Sheet trong tất cả các file đó thì mình phải làm thế nào ah. Kính mong thày giúp cho.
Bạn cũng phải đưa lên đây 1 vài file dùng font TCVN để tôi test chứ
Viết code từ đời nào rồi, ai mà nhớ (với lại máy tôi cũng chẳng có file nào dùng font cùi bắp này cả)
Em xin gửi file (font TCVN để test) , rất mong thày giúp cho.
Sub TCVN3_To_Unicode(ByVal Range As Range)
On Error Resume Next
Dim rCel As Range
Dim sFontName As String, sFormula As String
For Each rCel In Range
sFontName = rCel.Font.Name
sFormula = rCel.Formula
If Len(sFormula) Then
If Left(sFontName, 3) = ".Vn" Then
If sFontName Like ".Vn*H" Then
rCel = UCase(Vn3Uni(sFormula))
Else
rCel = Vn3Uni(sFormula)
End If
End If
End If
Next
Range.Font.Name = "Times New Roman"
End Sub
Sub CharSetConvert()
Dim fle As Object
Dim vFolder, wks As Worksheet
On Error Resume Next
vFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
On Error GoTo 0
If TypeName(vFolder) = "String" Then
vFolder = CStr(vFolder)
With CreateObject("Scripting.FileSystemObject")
Application.ScreenUpdating = False
For Each fle In .GetFolder(vFolder).Files
If UCase(fle.Path) <> UCase(ThisWorkbook.FullName) Then
If fle.Type Like "Microsoft Excel*" Then
With Workbooks.Open(fle.Path)
For Each wks In .Worksheets
TCVN3_To_Unicode wks.UsedRange
Next
.Close True
End With
End If
End If
Next
End With
End If
MsgBox "Thành công"
Application.ScreenUpdating = True
End Sub
Đã test xong!
Code sửa lại:
Mã:Sub TCVN3_To_Unicode(ByVal Range As Range) On Error Resume Next Dim rCel As Range Dim sFontName As String, sFormula As String For Each rCel In Range sFontName = rCel.Font.Name sFormula = rCel.Formula If Len(sFormula) Then If Left(sFontName, 3) = ".Vn" Then If sFontName Like ".Vn*H" Then rCel = UCase(Vn3Uni(sFormula)) Else rCel = Vn3Uni(sFormula) End If End If End If Next Range.Font.Name = "Times New Roman" End Sub
Bỏ hết code cũ, chỉ chừa lại Function Vn3UniMã:Sub CharSetConvert() Dim fle As Object Dim vFolder, wks As Worksheet On Error Resume Next vFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path On Error GoTo 0 If TypeName(vFolder) = "String" Then vFolder = CStr(vFolder) With CreateObject("Scripting.FileSystemObject") Application.ScreenUpdating = False For Each fle In .GetFolder(vFolder).Files If UCase(fle.Path) <> UCase(ThisWorkbook.FullName) Then If fle.Type Like "Microsoft Excel*" Then With Workbooks.Open(fle.Path) For Each wks In .Worksheets TCVN3_To_Unicode wks.UsedRange Next .Close True End With End If End If Next End With End If MsgBox "Thành công" Application.ScreenUpdating = True End Sub
Xem file và test thử nhé
-------------------
Tôi nghĩ code trong Function Vn3Uni còn có thể cải tiến để tăng tốc được nữa đấy (có thể dùng Replace chẳng hạn)
Em Test thử, tìm đúng tên Folder cần Test, nhưng kết quả nó vẫn là font .VnTime như cũ thày ah.
Các bạn khác vui lòng test giúp nhé
(vì tôi test không có cái vụ "như cũ" giống bạn đã nói)
Không hiểu sao em mở file của thày bằng Excel2003(Portable) hoặc Excel2010 thì được, nhưng riêng Excel2007 thì kết quả vẫn thế ah.
Mong các anh, chị có thời gian Test lại dùm em nhé.
Ủa! Code convert này liên quan gì đến vụ đuôi file nhỉ?
Nếu bạn chạy không thành công với đuôi xlsx thì nguyên nhân có thể là:
- Máy bạn đang cài 2 office
- Bạn thiết lập mặc định mở file XLS bằng Excel 2003
Chỉ có thể là vậy!
--
Em thắc mắc là hình như Icon biểu tượng file của thày nó có vẻ màu hơi khác so với excel2003 thì phải (tựa như biểu tượng của excel2002 ấy)? hihi cái này em không hiểu lắm nên em mới hỏi vậy ah.
Ủa! Code convert này liên quan gì đến vụ đuôi file nhỉ?
Nếu bạn chạy không thành công với đuôi xlsx thì nguyên nhân có thể là:
- Máy bạn đang cài 2 office
- Bạn thiết lập mặc định mở file XLS bằng Excel 2003
Chỉ có thể là vậy!
----------------
Tôi test trên máy tôi (dùng Office 2010), đuôi file nào cũng chơi tuốt
----------------
Nói thêm: Người ta có thể dùng Office 2003 hoặc 2010 hoặc cài cả 2 cùng lúc (như tôi đang xài) chứ chẳng ai lại đi xài cả 3 như bạn (Office 2007 vừa thừa lại vừa cùi bắp, xài làm gì không biết)
-----
Vì là máy cơ quan, chứ máy em thì em đã bỏ cái 2007 đi rồi (bản thân em thấy cái này chạy Code hay có vấn đề lắm).
Muốn biết nó có vấn đề gì, mở code ra, xóa hết mấy dòng On Error... rồi thử lại xem code báo lỗi chổ nào