Johannes
10-21-2005, 03:16 AM
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
12-23-2011, 01:51 AM
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
12-23-2011, 07:26 AM
'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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.