Sub PDF_Output()
Const JobTimeout As Integer = 15
Const PDF_DPI As Integer = 300
Const PDF_CompLevel As String = "JpegMedium"
Const DistPath As String = "C:\Tmp\TestPDF.pdf"
Dim PDFCreatorQueue As Queue
Dim PrintJob As PrintJob
Set PDFCreatorQueue = CreateObject("PDFCreator.JobQueue")
'Chọn PDFCreator tại đây
Application.Dialogs(xlDialogPrinterSetup).Show
PDFCreatorQueue.Initialize
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
If Not PDFCreatorQueue.WaitForJob(JobTimeout) Then
MsgBox ("Không thể xuất PDF vì không tìm thấy lệnh in.")
Else
Set PrintJob = PDFCreatorQueue.NextJob
PrintJob.SetProfileByGuid ("DefaultGuid")
'Compression
'Thay đổi tỷ lệ nén của hình ảnh tại đây…JpegMaximum (độ nén cao) → JpegMinimum (độ nén thấp)
Call PrintJob.SetProfileSetting("PdfSettings.CompressColorAndGray.Enabled", "True")
'Lấy mẫu lại ảnh rõ ràng
Call PrintJob.SetProfileSetting("PdfSettings.CompressColorAndGray.Resampling", "True")
'Cài đặt lấy mẫu lại ảnh (DPI 300)
Call PrintJob.SetProfileSetting("PdfSettings.CompressColorAndGray.Dpi", PDF_DPI)
'Nén ảnh được đặt thành nén trung bình
Call PrintJob.SetProfileSetting("PdfSettings.CompressColorAndGray.Compression", PDF_CompLevel)
PrintJob.ConvertTo (DistPath)
If (Not PrintJob.IsFinished Or Not PrintJob.IsSuccessful) Then
MsgBox ("Không thể xuất các tệp sau dưới dạng PDF. :" & DistPath)
End If
End If
MsgBox ("Hoàn thành xuất file PDF.")
PDFCreatorQueue.ReleaseCom
End Sub
Có rất ít trang web mà bạn có thể tham khảo, nhưng tôi nghĩ bạn có thể làm được nếu chỉ cần xem tài liệu tham khảo chính thức.Tác giả: Admin Arrebol
Ý kiến bạn đọc
Những tin cũ hơn
Cổ Nhơn là trò chơi dân gian từ xưa còn lưu truyền đến ngày hôm nay và chỉ xuất hiện trong dịp tết. Trò chơi này có ở thị trấn Bồng Sơn và một số xã lân cận như Hoài Đức, Hoài Tân, Hoài Thanh,…, thuộc huyện Hoài Nhơn, tỉnh Bình Định. Trò chơi thường bắt đầu vào ngày cuối cùng của năm cũ (29, 30,...