Có phần mềm nào mà chuyển đổi font cho toàn bộ các file excel trong Folder

Liên hệ QC
Em muốn hỏi khi đặt tên file là Test thu phải chăng cùng tên với từ khoá gì đó

File của bạn bị hư rồi nên không kiểm tra được
Xem lại nhé

Đú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ạ.
 

File đính kèm

  • Test thu.rar
    37.1 KB · Đọc: 29
Đú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ạ.
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:
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
Bạn kiểm tra lại xem thế nào nhé
--------------
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ần chỉnh sửa cuối:
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:
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
Bạn kiểm tra lại xem thế nào nhé
--------------
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!

Bây giờ em vẫn chưa biết gì về lập trình cả, ngoại trừ việc biết ghi Macro, do nhu cầu cần thiết nên em lang thang đi tìm trên mạng từ sáng để về ứng dụng, 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.

Cảm ơn thày rất nhiều, em sẽ chú ý vấn đề này trong thời gian tới khi em nghiên cứu về VBA.
 
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.
.
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)
Giờ bạn cứ test thử đi, cảm thấy sai chổ nào chúng ta lại bàn tiếp thôi (như vậy bạn sẽ nhớ lâu hơn)
 
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:
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
Bạn kiểm tra lại xem thế nào nhé
--------------
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ật không uổng công em tìm cả buổi tối về phần mềm chuyển mã font, em không biết nói gì hơn, em cảm ơn thày rất nhiều. Chức năng này thực sự rất cần thiết với mọi người, trong quá trình sử dụng, rất mong thày giúp em hoàn thiện chức năng này.
 

File đính kèm

  • Chuyen Font_thay Ndu tam chinh.rar
    12.3 KB · Đọc: 35
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.
 
Lần chỉnh sửa cuối:
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ả)
 
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.
 

File đính kèm

  • Test.rar
    55 KB · Đọc: 36
Em xin gửi file (font TCVN để test) , rất mong thày giúp cho.

Đã 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
Mã:
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
Bỏ hết code cũ, chỉ chừa lại Function Vn3Uni
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)
 

File đính kèm

  • Chuyen Font_thay Ndu tam chinh.xls
    53 KB · Đọc: 50
Đã 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
Mã:
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
Bỏ hết code cũ, chỉ chừa lại Function Vn3Uni
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é.

----
(Phải chăng chương trình Excel2007 của em có vấn đề?)
 
Lần chỉnh sửa cuố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!
----------------
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)
 
Lần chỉnh sửa cuối:
Ủ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!

Hình như cái Office2007 của em có vấn đề hay sao ấy. Nhưng file lúc sáng (chưa sửa Code) thì nó chạy vấn bình thường, chỉ có cái là không chuyển cho các sheet thôi ah.
--

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.
 
Lần chỉnh sửa cuối:
--

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.

File đó là file của bạn, tôi sửa code thôi mà
 
Ủ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)

Máy cơ quan em chỉ cài Office2007 thôi (cái 2003 là Portable thày ah), còn cái 2010 là em Test trên máy cá nhân của em. Quan trọng là nhờ có thày giúp từ nay em có công cụ rất hữu ích để chuyển font mà chất lượng rất tốt. Em cảm ơn thày rất nhiều.
-----
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).
 
-----
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
 
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

Vấn đề đáng nói ở chỗ là khi em chạy phiên bản 2007 nó lại báo là thành công (dù đã bỏ On Error), chỉ mỗi tội kết quả vẫn như cũ (không đổi được font) thế mới bực chứ, làm cho em mỗi lần sử dụng buộc phải dùng bản Portable2003.

Nếu không tìm ra nguyên nhân thì kệ nó, chắc là do cái vụ office2007 không ổn thôi thày ah. Em lấy máy cá nhân sài 2010, Test từ trưa đến nay kết quả đều rất tuyệt vời thày ah.
---
Mà em nghĩ ra rồi, khi mở Portable2003 thì nó không chuyển font cho những file Excel 2007 (.xlsx) là đúng.
 
Lần chỉnh sửa cuối:
Em Test đúng như file bài 37 (của bác Phanhanhdai) trên Excel 2010, còn 1 chút xíu lỗi nữa như sau:

ví dụ:
Nguồn (.VnTime) --> đích Times New Roman
-----------tính --> tÝnh
-----------kiến --> kiÕn
-----------Quyền--> QuyÒn

Không biết mọi người có gặp lỗi này không, nếu không cho em biết với nhé.
 
Lần chỉnh sửa cuối:
Web KT
Back
Top Bottom