And here is the code.
Code:
Option Explicit
Sub PrintToPDF()
'Author : Ken Puls
'Macro Purpose: Print to PDF file using PDFCreator
' Designed for early bind, set reference to PDFCreator
Dim pdfjob As Object
Dim sPDFName As String
Dim sPDFPath As String
Dim lSheet As Integer
Dim pdfname, localPdfPath, meses As Variant
Dim dta As String
If (Len(Month(Date) < 10)) Then
dta = Year(Date) & "0" & Month(Date) & Day(Date)
Else
dta = Year(Date) & Month(Date) & Day(Date)
End If
Dim Response, Style
Style = vbOKCancel + vbQuestion + vbDefaultButton2
Response = MsgBox("Quer realmente criar o PDF", Style, "Criar PDF's da Escala")
If Response = vbCancel Then Exit Sub
localPdfPath = "\\PDF"
pdfname = dta & "_Escala " & Application.ActiveSheet.Range("O4") _
& " " & Application.ActiveSheet.Range("P4") & " " & Application.ActiveSheet.Range("Q4") _
& " " & Application.ActiveSheet.Range("R4") _
& " " & Application.ActiveSheet.Range("S4") & " " & Application.ActiveSheet.Range("U4") _
& " " & TranslateChar(Application.ActiveSheet.Range("AC4"))
Set pdfjob = CreateObject("PDFCreator.clsPDFCreator")
sPDFPath = ActiveWorkbook.path & Application.PathSeparator
If pdfjob.cStart("/NoProcessingAtStartup") = False Then
MsgBox "Can't initialize PDFCreator.", vbCritical + _
vbOKOnly, "PrtPDFCreator"
Exit Sub
End If
If Not IsEmpty(ActiveSheet.UsedRange) Then
With pdfjob
sPDFName = pdfname & ".pdf"
sPDFPath = localPdfPath
.cOption("UseAutosave") = 1
.cOption("UseAutosaveDirectory") = 1
.cOption("AutosaveDirectory") = sPDFPath
.cOption("AutosaveFilename") = sPDFName
.cOption("AutosaveFormat") = 0 ' 0 = PDF
.cClearCache
End With
'Print the document to PDF
Worksheets(Application.ActiveSheet.name).PrintOut From:=1, To:=1, Copies:=1, ActivePrinter:="PDFCreator"
'Wait until the print job has entered the print queue
Do Until pdfjob.cCountOfPrintjobs = 1
DoEvents
Loop
pdfjob.cPrinterStop = False
'Wait until PDF creator is finished then release the objects
Do Until pdfjob.cCountOfPrintjobs = 0
DoEvents
Loop
End If
pdfjob.cClose
Set pdfjob = Nothing
End Sub
Bookmarks