Hướng dẫn code lưu file PDF

[saobekhonglac]

Chào Anh/Chị.

Nhờ Anh/Chị hướng dẫn giúp em code xuất dữ liệu ra PDF với điều kiện như sau:
In từ cột A đến cột AE cho đến hết dữ liệu (dòng có thông tin Bên A, Bên B, dòng cuối cùng có dữ liệu)
File có nhiều sheet, mỗi sheet lưu 1 file với tên là tên của ô Q14.
Như file đính kèm sẽ lưu được 2 file như file đính kèm em làm mẫu

Cám ơn Anh/Chị.

 

[giaiphap]

Chào Anh/Chị.

Nhờ Anh/Chị hướng dẫn giúp em code xuất dữ liệu ra PDF với điều kiện như sau:
In từ cột A đến cột AE cho đến hết dữ liệu (dòng có thông tin Bên A, Bên B, dòng cuối cùng có dữ liệu)
File có nhiều sheet, mỗi sheet lưu 1 file với tên là tên của ô Q14.
Như file đính kèm sẽ lưu được 2 file như file đính kèm em làm mẫu

Cám ơn Anh/Chị.

Bạn thử code này xem sao? Nhớ điều chỉnh các cột cho nó lọt vào một trang (theo chiều ngang) trước khi chạy code.

Sub Xuat_PDF()
On Error Resume Next
  Dim s As String, sh As Worksheet
  Dim PdfFile As String
    PdfFile = ThisWorkbook.Path
    If Right(PdfFile, 1) <> "\" Then PdfFile = PdfFile & "\"
   
    For Each sh In ThisWorkbook.Sheets
        s = PdfFile & sh.Range("Q14").Value & ".pdf"
        sh.PageSetup.PrintArea = sh.Range("A1:AE" & sh.Range("A65000").End(xlUp).Row).Address
        With sh
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:=s, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
        sh.PageSetup.PrintArea = ""
    Next sh
    MsgBox "Da xuat xong"
End Sub

 

[saobekhonglac]

Có code nào mình chỉnh cho tất cả các sheet không vậy bạn. Ví dụ như mặc định cột A độ rộng bao nhiêu, cột B, cột C,... cột AE. Khi chạy code thì tất cả các sheet sẽ có độ rộng cột giống nhau.

Bạn thử code này xem sao? Nhớ điều chỉnh các cột cho nó lọt vào một trang (theo chiều ngang) trước khi chạy code.

Sub Xuat_PDF()
On Error Resume Next
  Dim s As String, sh As Worksheet
  Dim PdfFile As String
    PdfFile = ThisWorkbook.Path
    If Right(PdfFile, 1) <> "\" Then PdfFile = PdfFile & "\"
  
    For Each sh In ThisWorkbook.Sheets
        s = PdfFile & sh.Range("Q14").Value & ".pdf"
        sh.PageSetup.PrintArea = sh.Range("A1:AE" & sh.Range("A65000").End(xlUp).Row).Address
        With sh
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:=s, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
        sh.PageSetup.PrintArea = ""
    Next sh
    MsgBox "Da xuat xong"
End Sub

 

[giaiphap]

Có code nào mình chỉnh cho tất cả các sheet không vậy bạn. Ví dụ như mặc định cột A độ rộng bao nhiêu, cột B, cột C,... cột AE. Khi chạy code thì tất cả các sheet sẽ có độ rộng cột giống nhau.

Thì bạn thêm dòng lệnh này Sh.Columns("A:A").ColumnWidth = 15 (Nếu muốn cột A bằng 15) vào xem sao.

Sub Xuat_PDF()
On Error Resume Next
  Dim s As String, sh As Worksheet
  Dim PdfFile As String
    PdfFile = ThisWorkbook.Path
    If Right(PdfFile, 1) <> "\" Then PdfFile = PdfFile & "\"
   
    For Each sh In ThisWorkbook.Sheets
        s = PdfFile & sh.Range("Q14").Value & ".pdf"
        Sh.Columns("A:A").ColumnWidth = 15
        sh.PageSetup.PrintArea = sh.Range("A1:AE" & sh.Range("A65000").End(xlUp).Row).Address
        With sh
          .ExportAsFixedFormat Type:=xlTypePDF, Filename:=s, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
        End With
        sh.PageSetup.PrintArea = ""
    Next sh
    MsgBox "Da xuat xong"
End Sub