[x]
Posted via EE Mobile

Search, ask, and monitor your questions on the go with EE Mobile. Visit Experts Exchange from your mobile device and never be out of touch again.
Question
[x]
Attachment Details
[x]
The Solution Rating System

With so many solutions, how can you tell which solutions are most likely to help you and which ones are not? To provide you with a tool to use, we rate our solutions based on various elements that most accurately determine if a solution is a quality solution. To explain what factors affect the solution rating, here are the elements we take into consideration when formulating our solution rating.

  • The Grade of the Solution
  • The Zone Rank of the Expert Providing the Solution
  • The Number of Author and Expert Comments
  • The Number of Experts Contributing
  • The Feedback of the Community

Your Input Matters
Because of the way the system is set up, the most important variable in this equation is you. As a member of Experts Exchange, you are able to cast your vote on the quality of the solutions in regard to how complete, accurate, helpful and easy to understand each solution is. When you provide your feedback, each rating is adjusted accordingly. So, if you see a solution that has a poor rating that you think is a good solution, let us know by rating it. As you do, the rating will be adjusted and will become more accurate for other members of our site.

If you have any suggestions that you would like to make for our rating system, please ask a question in the Suggestions Zone of Community Support.

Thank you!
9.9

Advanced pdf generation from xls with vba - separate pdf file for page 1 and page 2

Asked by stmoritz in Microsoft Excel Spreadsheet Software, Adobe Acrobat

I am using below VBA code in an excel sheet based on experts-exchange.com here: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_23086401.html

This code creates a pdf file of the excel sheet "fact sheet e" to the path and filename defined in range "aa2" of the respective excel sheet.

I would like to expand this code to an advanced mode:

1) create pdf of page 1 of the excel sheet to path and name in range aa2
2) create pdf of page 2 of the excel sheet to path and name in range aa3
3) append page 2 of the excel sheet to an already existing pdf (path and name in range aa4)

any suggestions?

many thanks! 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:

Public Sub PrintFactSheetToPDF()
 
Dim PdfOutputFileName As String
PdfOutputFileName = Range("aa2").Value
 
   PrintSheetsToPDF Array("fact sheet e"), PdfOutputFileName
 
End Sub
Public Function PrintSheetsToPDF( _
      ByVal SheetsToPrint As Variant, _
      ByVal PDFFilePath As String, _
      Optional ByVal ReorderSheets As Boolean _
   ) As Boolean
 
' Print the specified sheets to a PDF file in the order specified. Requires
' Adobe Acrobat 7.0 and a reference to Acrobat Distiller. Returns True if the
' print was successful, False otherwise.
'
' Syntax
'
' PrintSheetsToPDF(Sheets, PDFFilePath, [ReorderSheets])
'
' 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.
'
' 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"
   
   ' Save the current active worksheet
   Set OriginalActiveWorksheet = ActiveSheet
   
   If ReorderSheets Then
   
      ' Save the current sheet order
      ReDim OriginalOrderNames(1 To ThisWorkbook.Sheets.Count)
      For Index = 1 To ThisWorkbook.Sheets.Count
         OriginalOrderNames(Index) = ThisWorkbook.Sheets(Index).Name
      Next Index
     
      ' Reorder the worksheets
      For Index = UBound(SheetsToPrint) To LBound(SheetsToPrint) Step -1
         If ThisWorkbook.Sheets(SheetsToPrint(Index)).Index > 1 Then
            ThisWorkbook.Sheets(SheetsToPrint(Index)).Move Before:=ThisWorkbook.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
   Err.Clear
   ThisWorkbook.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 ThisWorkbook.Sheets.Count
         If ThisWorkbook.Sheets(OriginalOrderNames(Index)).Index <> Index Then
            ThisWorkbook.Sheets(OriginalOrderNames(Index)).Move Before:=ThisWorkbook.Sheets(Index)
         End If
      Next Index
   End If
   
   ' Restore the original active worksheet
   OriginalActiveWorksheet.Activate
 
   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
 
Related Solutions
Keywords: Advanced pdf generation from xls with…
Title
1 Extracting addresses from email body
 
Loading Advertisement...
 
[+][-]03/28/08 05:14 PM, ID: 21234904Accepted Solution

View this solution now by starting your 30-day free trial. Setting up your free trial is quick, easy, and secure. We will return you to this solution, unlocked, when you're done.

About this solution

Zones: Microsoft Excel Spreadsheet Software, Adobe Acrobat
Sign Up Now!
Solution Provided By: zorvek
Participating Experts: 1
Solution Grade: A
 
 
Loading Advertisement...
20091111-EE-VQP-92 / EE_QW_2_20070628