Printing to PDF using Adobe Distiller

[Johannes]

I am trying to write code that prints an(y) Excel workbook to PDF, but I run into two problems:

1) setting the printer properties for layout (landscape/portrait) and color and

2) setting the output filename and folder definition.

The idea is that the filename could be equal to the sheetname and in addition, I have to specify the output folder.

When I print "manually" to PDF using Adobe Distiller, a dialog box is presented where you are asked to type in the file name. The file is then printed to a default folder ("infolder" in Adobe terminology?), but is automatically moved to a second folder ("outfolder" in Adobe terminology?). None of these settings are recorded when I use the VBA macro recorder. Finally, I want to run this code while logged on to the company network, so I hope to be able to avoid changing any .ini files or whatever, as I fear that that could be in conflict with our strict security regulations..

[NashProjects]

Why dont you use cutepdf printer... its free and alot more userfriendly

However if you really have to use Acrobat this has worked for me


Dim oPDF As PdfDistiller
Set oSheet = ActiveSheet
Set oPDF = New PdfDistiller
TmpPSFile = "c:\TmpPSFile.ps"
sFilepath = "C:\Documents"

PDFFile = sfilepath & "\OutputPDF File.pdf"
PSFile = sfilepath & "\OutputPdf File.log"
appWD.ActivePrinter = "Adobe PDF"
appWD.ActiveDocument.PrintOut copies:=1, printtofile:=True, collate:=True, OutputFileName:=TmpPSFile

oPDF.FileToPDF TmpPSFile, PDFFile, ""

[Kenneth Hobs]

[VBA]'http://www.mrexcel.com/forum/showthread.php?p=2850609
Sub Test_PublishToPDF()
Dim sDirectoryLocation As String, sName As String

sDirectoryLocation = ThisWorkbook.Path
sName = sDirectoryLocation & "\" & Range("E4").Value2 & ".pdf"
PublishToPDF sName, ActiveSheet
End Sub


Sub PublishToPDF(fName As String, ws As Worksheet)
Dim rc As Variant

'ChDrive "c:"
'ChDir GetFolderName(fName)
rc = Application.GetSaveAsFilename(fName, "PDF (*.pdf), *.pdf", 1, "Publish to PDF")
If rc = "" Then Exit Sub

ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

Sub PublishToPDF1(fName As String)
Dim rc As Variant

'ChDrive "c:"
'ChDir GetFolderName(fName)
rc = Application.GetSaveAsFilename(fName, "PDF (*.pdf), *.pdf", 1, "Publish to PDF")
If Not rc Then Exit Sub

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fName _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub

Function GetFolderName(Filespec As String) 'Returns path with trailing "\"
'Requires GetFileName() function above
GetFolderName = Left(Filespec, Len(Filespec) - Len(GetFileName(Filespec)))
End Function

Function GetFileName(Filespec As String)
Dim FSO As Object, s As String
Set FSO = CreateObject("Scripting.FileSystemObject")
s = FSO.GetFileName(Filespec)
Set FSO = Nothing
GetFileName = s
End Function

Function GetBaseName(Filespec As String)
Dim FSO As Object, s As String
Set FSO = CreateObject("Scripting.FileSystemObject")
s = FSO.GetBaseName(Filespec)
Set FSO = Nothing
GetBaseName = s
End Function



'http://msdn.microsoft.com/en-us/library/aa159895%28v=office.11%29.aspx
Function PDFSaveAs(initialFilename As String, _
Optional sDesc As String = "PDF", _
Optional sFilter As String = "*.pdf") As String
'With Application.FileDialog(msoFileDialogOpen)
With Application.FileDialog(msoFileDialogFilePicker)
.ButtonName = "PDF &Save As"
.initialFilename = initialFilename
.Filters.Clear
.Filters.Add sDesc, sFilter, 1
.Title = "Publish to PDF"
.AllowMultiSelect = False
PDFSaveAs = ""
.Execute
If .Show = -1 Then PDFSaveAs = .SelectedItems(1)
End With
End Function
[/VBA]