Hi all,
Need some help adding additional functionality to the code below. The macro recurses through an Excel spreadsheet and sends each page to an Adobe printer driver for PDF creation. The page breaks on the spreadsheet define what to print.
The spreadsheet has changed a bit and now includes two pages vs. one which presents a challenge. There is now a horizontal page break which creates page two and the macro creates two files. I would like it to create one file with two pages.
I would appreciate any help with this.
Thanks.
-B
Need some help adding additional functionality to the code below. The macro recurses through an Excel spreadsheet and sends each page to an Adobe printer driver for PDF creation. The page breaks on the spreadsheet define what to print.
The spreadsheet has changed a bit and now includes two pages vs. one which presents a challenge. There is now a horizontal page break which creates page two and the macro creates two files. I would like it to create one file with two pages.
I would appreciate any help with this.
Thanks.
-B
Code:
Sub ExceltoPDF()
Dim iVBreaks As Integer
Dim iTotPages As Integer
Dim pb As VPageBreak
Dim myLoop As Integer
Dim STDprinter As String
Dim PSFileName As String
Dim PDFFileName As String
Dim myPDF As PdfDistiller
Set myPDF = New PdfDistiller
PSFileName = "c:\PDF_Temp\myPostScript.ps"
STDprinter = Application.ActivePrinter
Application.ActivePrinter = GetFullNetworkPrinterName("Adobe PDF")
Application.ScreenUpdating = False
iVBreaks = ActiveSheet.VPageBreaks.Count + 1
MsgBox iVBreaks & " pages will be exported to PDF, OK to proceed?", vbInformation, "Page Ranges in " & ActiveSheet.Name
i = iVBreaks
For j = 0 To i
On Error Resume Next
PDFFileName = "c:\PDF_Temp\PDF\" & ActiveSheet.Cells(3, 2).Text & "-" & ActiveSheet.VPageBreaks(j).Location.Cells(1, 0).Value & "-PCAA.pdf"
ActiveWindow.SelectedSheets.PrintOut From:=j, To:=j, Copies:=1, Collate:=True, PrintToFile:=True, PrToFileName:=PSFileName
myPDF.FileToPDF PSFileName, PDFFileName, ""
Kill Left(PDFFileName, Len(PDFFileName) - 3) & "log"
Kill (PSFileName)
Next
Application.ActivePrinter = STDprinter
End Sub
Function GetFullNetworkPrinterName(strNetworkPrinterName As String) As String
' Returns the full network printer name
' Returns an empty string if the printer is not found
' Example GetFullNetworkPrinterName("HP LaserJet 8100 Series PCL") might return "HP LaserJet 8100 Series PCL on Ne04:"
Dim strCurrentPrinterName As String, strTempPrinterName As String, i As Long
strCurrentPrinterName = Application.ActivePrinter
i = 0
Do While i < 100
strTempPrinterName = strNetworkPrinterName & " on Ne" & Format(i, "00") & ":"
On Error Resume Next ' try to change to the network printer
Application.ActivePrinter = strTempPrinterName
On Error GoTo 0
If Application.ActivePrinter = strTempPrinterName Then
' the network printer was found
GetFullNetworkPrinterName = strTempPrinterName
i = 100 ' makes the loop end
End If
i = i + 1
Loop
' Remove the line below if you want the function to change the active printer
'Application.ActivePrinter = strCurrentPrinterName ' Change back to the original printer
End Function