Excel: Print File to PDF Distiller

Posted on 2010-01-11
Medium Priority
Last Modified: 2012-05-08

I have a module that will create a folder and then print a spreadsheet into pdf. (See Code below)

It does not work, and the following msg pop up.

"When you create a postscript file you have to send the host fonts. Please go to the printer properties, "'Adobe PDF Settings' page and turn OFF The options 'Do not send fonts to Distiller'."

I tried to turn off the "Do not send fonts to Distiller", and the modules went through. Nonetheless, I am not able to open the file. It said the file is corrupted.

Any idea how I can fix this?

Sub PrintToFile(strPath As String, strFileName As String)

    MkDir (strPath & strFileName)
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, PrintToFile:=True, _
                        prtofilename:=strPath & strFileName & "\" & strFileName & ".pdf"

End Sub

Open in new window

Question by:IEHP1
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
LVL 81

Accepted Solution

zorvek (Kevin Jones) earned 2000 total points
ID: 26286318
The routine below prints one or more worksheets to a single PDF file. The worksheets are printed to the PDF document in the order specified. The code requires Adobe Acrobat 6.0 or later. See the documentation in the code for how to use the routine.

[Begin Code Segment]

Public Function PrintSheetsToPDF( _
      ByVal SheetsToPrint As Variant, _
      ByVal PDFFilePath As String, _
      Optional ByVal ReorderSheets As Boolean, _
      Optional ByVal Workbook As Workbook _
   ) As Boolean

' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 6.0 and a reference to Acrobat Distiller. Returns True if the
' print was successful, False otherwise.
' Syntax
' PrintSheetsToPDF(Sheets, PDFFilePath, [ReorderSheets], [Workbook])
' SheetsToPrint - Array of sheet names to be printed. The sheets included are
'   sorted in that order and then printed in one print job. When the printing
'   is complete the original order is restored.
' PDFFilePath - Full path to the PDF file.
' ReorderSheets - Pass True to reorder the sheets to be printed in the order
'   specified, False to not sort. optional. If omitted then False is assumed.
' Workbook - The workbook containing the sheets to print. Optional. If ommited
'   then the workbook in which this code resides is assumed.
' Example
' Print sheets "Sheet4", "Sheet10", and "Sheet1" in that order:
'   PrintSheetsToPDF Array("Sheet4", "Sheet10", "Sheet1"), "C:\Output.PDF"
   Dim Errors As Boolean
   Dim OriginalActiveWorksheet As Object
   Dim OriginalOrderNames As Variant
   Dim Index As Long
   Dim PDFDistillerApplication As PdfDistiller
   Dim TempPFFilePathName As String
   Dim PDFLogPathName As String
   Dim Result As Long
   ' Normalize the sheets to print parameter
   If Not IsArray(SheetsToPrint) Then SheetsToPrint = Array(SheetsToPrint)
   For Index = LBound(SheetsToPrint) To UBound(SheetsToPrint)
      If TypeName(SheetsToPrint(Index)) = "Worksheet" Then SheetsToPrint(Index) = SheetsToPrint(Index).Name
   Next Index
   ' Normalize the output pdf file name
   If LCase(Right(PDFFilePath, 4)) <> ".pdf" Then PDFFilePath = PDFFilePath & ".pdf"
   ' Normalize the workbook parameter
   If Workbook Is Nothing Then Set Workbook = ThisWorkbook
   ' Save the current active worksheet
   Set OriginalActiveWorksheet = Workbook.ActiveSheet
   If ReorderSheets Then
      ' Save the current sheet order
      ReDim OriginalOrderNames(1 To Workbook.Sheets.Count)
      For Index = 1 To Workbook.Sheets.Count
         OriginalOrderNames(Index) = Workbook.Sheets(Index).Name
      Next Index
      ' Reorder the worksheets
      For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
         If Workbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
            Workbook.Sheets(SheetsToPrint(Index)).Move Before:=Workbook.Sheets(1)
         End If
      Next Index
   End If
   ' Print the worksheets
   TempPFFilePathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "pf"
   PDFLogPathName = Left(PDFFilePath, InStrRev(PDFFilePath, ".")) & "log"
   On Error Resume Next
   Kill TempPFFilePathName
   Workbook.Worksheets(SheetsToPrint).PrintOut ActivePrinter:="Adobe PDF", PrintToFile:=True, Collate:=True, PrToFilename:=TempPFFilePathName
   If Err.Number <> 0 Then
      MsgBox "To prevent this error from occurring in the future, open the Properties window for the 'Adobe PDF' printer, click the command button 'Printing Preferences', and uncheck the option 'Do not send fonts to ""Adobe PDF""'. Before the changes will take effect Excel must be quit and restarted."
      Errors = True
   End If
   On Error GoTo 0

   If ReorderSheets Then
      ' Restore the original worksheet order
      For Index = 1 To Workbook.Sheets.Count
         If Workbook.Sheets(OriginalOrderNames(Index)).Index <> Index Then
            Workbook.Sheets(OriginalOrderNames(Index)).Move Before:=Workbook.Sheets(Index)
         End If
      Next Index
   End If
   ' Restore the original active worksheet

   If Not Errors Then
      ' Convert the postscript file to .pdf
      Set PDFDistillerApplication = New PdfDistiller
      Result = PDFDistillerApplication.FileToPDF(TempPFFilePathName, PDFFilePath, "")
      On Error Resume Next
      Kill TempPFFilePathName
      If Result = 1 Then Kill PDFLogPathName
      On Error GoTo 0
   End If
   PrintSheetsToPDF = Not Errors
End Function

[End Code Segment]


Author Closing Comment

ID: 31675676
COOL Solution! Thanks!

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This article describes a serious pitfall that can happen when deleting shapes using VBA.
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question