Wish I could take credit for this project. The main code is from Mr.
McDaniel and has been modified with input from other developers.
What is interesting is that every printer name in your "Printer and Faxes"
folder ends in "on NeXX", where "XX" is a different number for each printer
listed. Therefore, you must use the STOP as shown below and then hover over
the line above it to know what number will replace the XX.
If you need code to send as an email attachment I can send that to you as
well.
*******************************************
Sub PrintToPDF()
' SOURCE: Ken McDaniel version -->
http://www.planetpdf.com/mainpage.asp?webpageid=762
On Error GoTo SubErr
Dim PSFileName As String
Dim PDFFileName As String
Dim DistillerCall As String
Dim ReturnValue As Variant
Application.StatusBar = "Creating PDF of Calendar"
' Set folder path and file names
Dim DocsFolder As String
'DocsFolder = CreateObject("WScript.Shell").SpecialFolders("Desktop")
DocsFolder = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
'MsgBox DocsFolder
PSFileName = DocsFolder & "\PigeonTrainingCalendar.PS"
PDFFileName = DocsFolder & "\PigeonTrainingCalendar.PDF"
'MsgBox PDFFileName
'Stop
'If the files already exist, delete them:
If Dir(PSFileName) <> "" Then Kill (PSFileName)
If Dir(PDFFileName) <> "" Then Kill (PDFFileName)
''The Sendkeys characters are the full path and filename, followed by the
"Enter" key.
' These are buffered until the "print to file" screen appears:
SendKeys PSFileName & "{ENTER}", False
'Print the document to PDF
'ActiveSheet.PrintOut , PrintToFile:=True ' ORIGINAL CODE
'Print the document to PDF specifically using the"Adobe PDF on Ne07:"
Dim STDprinter As String
STDprinter = Application.ActivePrinter
'To get the adobe PDF printer name, set it as the default printer
and use this stop
' then hover over the line above to get the actual printer name
'Stop
' change printer
Application.ActivePrinter = "Adobe PDF on Ne07:"
' prints the active sheet
ActiveSheet.PrintOut , PrintToFile:=True
' change back to standard printer
Application.ActivePrinter = STDprinter
'Add double quotes around the PS filename and PDF filename:
PSFileName = Chr(34) & PSFileName & Chr(34)
PDFFileName = Chr(34) & PDFFileName & Chr(34)
'Modify path below to where your Acrodist.exe is located
DistillerCall = "C:\Program Files\Adobe\Acrobat 8\Acrobat\Acrodist.exe" & _
" /n /q /o" & PDFFileName & " " & PSFileName
'Call the Acrobat Distiller to distill the PS file. ReturnValue is zero
'if the application doesn't open correctly:
ReturnValue = Shell(DistillerCall, vbNormalFocus)
If ReturnValue = 0 Then MsgBox "Creation of " & PDFFileName & "failed."
Application.StatusBar = ""
MsgBox "The PDF creation process is now complete!", vbInformation
SubExit:
Exit Sub
SubErr:
MsgBox "An Error occured during PDF Preparation:" & vbCrLf & Error,
vbInformation, "Problem"
Resume SubExit
End Sub
*******************************************
Good luck,
Ken Olson
