Specify Sheets to Print to PDF in VBA

p_smith

New member
Joined
Jun 14, 2013
Messages
6
Reaction score
0
Points
0
I want to be able to call in 3 sheets out of 100+ sheets in the "Specify Sheets to Print" line. I want to call in the sheets by name so that each sheet gets printed as a different PDF. I am not sure if an array is the proper way to do this, but it is not working. Thanks in advance for your help!

Code:
Option Explicit

Sub PrintToPDF()


    Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPath As String
    Dim lSheet As Long
    Dim bRestart As Boolean


    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    '/// Edit Output file path ///
    sPDFPath = "C:\Users\pxxxxxx\Documents\New folder (2)"


    'Check PDFCreator
    Do
        bRestart = False
        Set pdfjob = New PDFCreator.clsPDFCreator
        If pdfjob.cStart("/NoProcessingAtStartup") = False Then
            'PDF Creator is running: Kill the existing process
            Shell "taskkill /f /im PDFCreator.exe", vbHide
            DoEvents
            Set pdfjob = Nothing
            bRestart = True
        End If
    Loop Until bRestart = False


        'Specify Sheets to Print
            ThisWorkbook.Sheets(Array("INGRED", "Position")).Select
            For lSheet = 1 To ThisWorkbook.ActiveSheet.Count
            If Not IsEmpty(Sheets(lSheet).UsedRange) Then
                    With pdfjob
    
            '/// Edit Output file name ///
            sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & ".pdf"
            
            'Check for Duplicates and Increment the File Name
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V1" & ".pdf"
            End If
            End With


            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V2" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V3" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V4" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V5" & ".pdf"
            End If
            End With
            
            'Prepare file to save
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
                
            'Print the document
            Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has queued
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
            Loop
        End If
    Next lSheet
    
Cleanup:
    'Release objects and terminate program
    Set pdfjob = Nothing
    Shell "taskkill /f /im PDFCreator.exe", vbHide
    On Error GoTo 0
    Application.ScreenUpdating = True
    Exit Sub




EarlyExit:
    'Inform user of error, and go to cleanup section
    MsgBox "There was an error and the file was not created." & vbCrLf & _
           "Please try again.", _
           vbCritical + vbOKOnly, "Error!"
    
    Resume Cleanup
End Sub

 

p_smith

New member
Joined
Jun 14, 2013
Messages
6
Reaction score
0
Points
0
I think this is closer to a correct array for this purpose.

Code:
        'Specify Sheets to Print
            lSheet = 0
            ListOfSheets = ["Sheet1","Sheet3"]
            While ThisWorkbook.Sheets(ListOfSheets(lSheet).Select)
                    With pdfjob
    
            '/// Edit Output file name ///
            sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & ".pdf"
            
            'Check for Duplicates and Increment the File Name
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V1" & ".pdf"
            End If
            End With


            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V2" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V3" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V4" & ".pdf"
            End If
            End With
            
            With Application.FileSearch
                .NewSearch
                .LookIn = sPDFPath
                .Filename = sPDFName
            If .Execute() <> 0 Then
                sPDFName = Sheets(lSheet).Name & Format(Now, " mm-dd-yyyy") & " V5" & ".pdf"
            End If
            End With
            
            'Prepare file to save
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
                
            'Print the document
            Worksheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has queued
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
            Loop
        lSheet = lSheet + 1
        Wend
 

JeffreyWeir

Super Moderator
Staff member
Joined
Mar 22, 2011
Messages
357
Reaction score
0
Points
0
Location
New Zealand
Just to be clear, does the above 2nd approach work, or are you still stuck?
 
Top