Chuyển code tự lưu xuất file xlsx thành pdf

[adult]

Chào các anh chị cùng các thầy cô,
Mình có áp dụng code dưới đây (lượm được từ các anh chị ở đây) và áp dụng cho file của mình chạy khá ổn.

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).Close _
                    True, strPath & "\ Ten Sheet " & sh.Name
     Next
  Application.ScreenUpdating = True
  
  End Sub

Nhưng bây giờ, do nhu cầu công việc thay đổi, các sếp yêu cầu phải xuất pdf chứ không cho dùng file excel nữa. Em có thử thay đổi nhưng toàn báo lỗi. Nhờ các anh chị sửa lại đoạn code trên xuất ra file .pdf
Cảm ơn các anh chị nhiều

 

[nghiaphuc]

Chào các anh chị cùng các thầy cô,
Mình có áp dụng code dưới đây (lượm được từ các anh chị ở đây) và áp dụng cho file của mình chạy khá ổn.

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).Close _
                    True, strPath & "\ Ten Sheet " & sh.Name
     Next
  Application.ScreenUpdating = True
  
  End Sub

Nhưng bây giờ, do nhu cầu công việc thay đổi, các sếp yêu cầu phải xuất pdf chứ không cho dùng file excel nữa. Em có thử thay đổi nhưng toàn báo lỗi. Nhờ các anh chị sửa lại đoạn code trên xuất ra file .pdf
Cảm ơn các anh chị nhiều

Record Macro đi bạn, sau đó chỉnh sửa chút là xài được thôi.

 

[Mutants Men]

Chào các anh chị cùng các thầy cô,
Mình có áp dụng code dưới đây (lượm được từ các anh chị ở đây) và áp dụng cho file của mình chạy khá ổn.

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).Close _
                    True, strPath & "\ Ten Sheet " & sh.Name
     Next
  Application.ScreenUpdating = True
  
  End Sub

Nhưng bây giờ, do nhu cầu công việc thay đổi, các sếp yêu cầu phải xuất pdf chứ không cho dùng file excel nữa. Em có thử thay đổi nhưng toàn báo lỗi. Nhờ các anh chị sửa lại đoạn code trên xuất ra file .pdf
Cảm ơn các anh chị nhiều

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _        Filename:=ThisWorkbook.Path & "\" & [B]xxxxxxx[/B] & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True

sửa chỗ xxxxxxx đó lại theo ý bạn nhé

 

[adult]

    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _        Filename:=ThisWorkbook.Path & "\" & [B]xxxxxxx[/B] & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True

sửa chỗ xxxxxxx đó lại theo ý bạn nhé

Mình có sửa lại theo như thế này. Nhưng bị báo lỗi. Bạn coi lại giúp nhé. Cảm ơn nhiều

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strPath & "\" & sh.Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        
    Next
  Application.ScreenUpdating = True
  
  End Sub

Sửa theo kiểu này cũng lỗi

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        Application.Workbooks(Application.Workbooks.Count).ExportAsFixedFormat xlTypePDF, strPath & "\" & sh.Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
     Next
  Application.ScreenUpdating = True
  
  End Sub

 

[nghiaphuc]

Mình có sửa lại theo như thế này. Nhưng bị báo lỗi. Bạn coi lại giúp nhé. Cảm ơn nhiều

Sub LuuFile()
   Dim strPath As String
   Dim sh As Worksheet
   Application.ScreenUpdating = False
   strPath = ThisWorkbook.Path
   
     For Each sh In ThisWorkbook.Worksheets
        sh.Copy
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=strPath & "\" & sh.Name & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=True
        
    Next
  Application.ScreenUpdating = True
  
  End Sub

Bạn sửa lại thế này nhé:
[GPECODE=vb]Sub LuuFile()
Dim strPath As String
Dim sh As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
strPath = ThisWorkbook.Path
For Each sh In ThisWorkbook.Worksheets
sh.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strPath & "" & sh.Name & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[adult]

Bạn sửa lại thế này nhé:
[GPECODE=vb]Sub LuuFile()
Dim strPath As String
Dim sh As Worksheet
Application.ScreenUpdating = False
On Error Resume Next
strPath = ThisWorkbook.Path
For Each sh In ThisWorkbook.Worksheets
sh.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=strPath & "" & sh.Name & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

Vẫn không được bạn ơi. Nó không còn báo lỗi nữa nhưng cũng không thấy file xuất ra đâu cả. Bạn kiểm tra lại giúp mình với nhé.

 

[anhdepjai]

Bạn dùng office bản nào đấy. Nếu 2007 down thì bạn cài thêm cái này rồi record macro mà sửa lại nhé.

 

[adult]

Bạn dùng office bản nào đấy. Nếu 2007 down thì bạn cài thêm cái này rồi record macro mà sửa lại nhé.

Mình có record và kết hợp với cái code trên mà vẫn chưa biết khắc phục lỗi như thế nào.

 

[nghiaphuc]

Vẫn không được bạn ơi. Nó không còn báo lỗi nữa nhưng cũng không thấy file xuất ra đâu cả. Bạn kiểm tra lại giúp mình với nhé.

Tôi đã thử code trước khi post lên, code chạy bình thường, đúng theo yêu cầu. Tôi xài Office 2013, 32 bit, chạy trên Win 10, 64 bit.

 

[adult]

Tôi đã thử code trước khi post lên, code chạy bình thường, đúng theo yêu cầu. Tôi xài Office 2013, 32 bit, chạy trên Win 10, 64 bit.

Ah. Được rồi bạn ơi, do mình cẩn thận quá, để trên sheet trắng và book không có bất cứ dữ liệu nên chắc vậy mà PDF nó ko chịu ghi thông tin.
Cảm ơn bạn nhiều nhiều

 

[nghiaphuc]

Ah. Được rồi bạn ơi, do mình cẩn thận quá, để trên sheet trắng và book không có bất cứ dữ liệu nên chắc vậy mà PDF nó ko chịu ghi thông tin.
Cảm ơn bạn nhiều nhiều

Thực ra thì trong code của tôi đã đề phòng trường hợp này rồi. Câu lệnh On Error Resume Next đưa vào là nhằm mục đích này đấy.