• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2002
  • Last Modified:

Excel: Print File to PDF Distiller


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

1 Solution
zorvek (Kevin Jones)ConsultantCommented:
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]

IEHP1Author Commented:
COOL Solution! Thanks!

Featured Post

[Webinar On Demand] Database Backup and Recovery

Does your company store data on premises, off site, in the cloud, or a combination of these? If you answered “yes”, you need a data backup recovery plan that fits each and every platform. Watch now as as Percona teaches us how to build agile data backup recovery plan.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now