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
Chào tất cả các bạn. Mình là Nguyên đây, Nguyen Arrebol chính là khởi đầu đầu tiên trên con đường học tập, tìm hiểu về IT của bản thân mình. Và mình muốn chia sẻ đến các bạn đồng trang lứa những kinh nghiệm học tập, những sở thích, quá trình mà mình tìm hiểu. Đồng thời Nguyen Arrebol sẽ là nơi lưu...