Macro to Increment and Print to PDF filename from merged cell

**ahjualune** · 08-07-2012, 09:15 AM

Hi everybody,

I'm a total beginner at this. I'm trying to create a macro that would ask a user for a serial number and quantity and based on that print the right amount of documents. There are several but's here though.
The Workbook this will be used on is protected. The cell where the serial number is entered is a merged cell. Information is stored on 4-5 worksheets, while only sheet 5 needs to be printed. The serial number consists of a mix of letters and numbers (ie. G19273WE0000001)
This is what I've got so far but it doesn't work for reasons unknown to me.

Sub PrintToPDF()
b = Application.InputBox("First Serial :", , , , , , , 2)
If Len(b) = 17 Then
Sheets("2").Range("A1:A3").Value = b
Else: MsgBox "The serial entered does not contain 17 digits"
End If
   Dim avarSplit As Variant
   Dim bvarSplit As Variant
    avarSplit = (Mid(b, 1, [13]))
    bvarSplit = (Mid(b, 14, [4]))
a = Application.InputBox("How many pages would You like to print?:", , , , , , , 1)
If a < 1 Then
MsgBox "Only Chuck Norris can print less than 1 copy at a time and still get stuff printed"
For n = 1 To a
ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:= _
"PDFCreator on PDFCreator:"
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 2
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
filename = "C:\Documents and Settings\user\Desktop\sodi\" & Sheets("2").Range("A1").Value & ".pdf"
SendKeys filename & "{Enter}", False
Sheets("2").Select
Sheets("2").Range("A1").Value = avarSplit & bvarSplit
Sheets("5").Select
bvarSplit = bvarSplit + 1
Next n
End If
End Sub

I believe I may have defined bvarSplit wrong as a variant but for the life of me I can't figure out how else to define it so that it could be incremented and retain the 0-s in front.
I've tried removing the time delay and else clause about the number of digits, but to no avail.
Using WinXP and Excel 2007. I could really use some help on this.

I could get the following script running, but it doesn't consider the entered serial number when printing the first page.

Sub Print()
a = Application.InputBox("How many pages would You like to print?:", , , , , , , 1)
If a < 1 Then
MsgBox "Only Chuck Norris can print less than 1 copy at a time and still get stuff printed"
Exit Sub
End If
b = Application.InputBox("First serial number :", , , , , , , 2)
If Len(b) = 17 Then
    
   Dim avarSplit As Variant
     
    avarSplit = (Mid(b, 1, [13]))
    bvarSplit = (Mid(b, 14, [4]))
           
For n = 1 To a
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Sheets("2").Select
Sheets("2").Range("A1:A3").Value = avarSplit & bvarSplit
bvarSplit = bvarSplit + 1
Sheets("5").Select
Next n
Else: MsgBox "The serial entered does not contain 17 digits"
End If
End Sub

So what I'm essntially struggling with is this:
1) The script seems to ignore anything printing related
2) How do I retain zeros in the last 4 digits of the serial number while incrementing it

**ahjualune** · 08-08-2012, 03:15 AM

I've taken a slightly different approach and using PDFCreator instead. This is even better in my case seeing that other people that will be using this macro already have PDFCreator installed. This is what I've got so far. Credits are due to:
http://www.excelguru.ca/content.php?161 and numerous other selfless VBA guides found on the web.

Sub PrintToPDF()
b = Application.InputBox("First Serial :", , , , , , , 2)
If Len(b) = 17 Then
Sheets("2").Range("A1").Value = b
End If
   Dim avarSplit As Variant
   Dim bvarSplit As Variant
   Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPath As String
    Dim lSheet As Long
    Dim bRestart As Boolean

    avarSplit = (Mid(b, 1, [13]))
    bvarSplit = (Mid(b, 14, [4]))
a = Application.InputBox("How many pages would You like to print?:", , , , , , , 1)
If a < 1 Then
MsgBox "Only Chuck Norris can print less than 1 copy at a time and still get stuff printed"
Else: GoTo g
g:
'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

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


For lSheet = 1 To a


Sheets("2").Select
Sheets("2").Range("A1").Value = avarSplit & bvarSplit
Sheets("5").Select

            With pdfjob
                '/// Change the output file name here! ///
                sPDFName = Sheets("2").Range("A1") & ".pdf"
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
    
            'Print the document to PDF
            Worksheets("5").PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has entered the print queue
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up before moving on
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
        bvarSplit = bvarSplit + lSheet - 1
            Loop
    
    Next lSheet
    
Cleanup:
    'Release objects and terminate PDFCreator
    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 encountered.  PDFCreator has" & vbCrLf & _
           "has been terminated.  Please try again.", _
           vbCritical + vbOKOnly, "Error"
    Resume Cleanup
End If
End Sub

The problem I'm still struggling with is properly incrementing the serial number without losing the 0-s. Obviously the line

bvarSplit = bvarSplit + lSheet - 1

does not work at all. How can I mend this?

**ahjualune** · 09-17-2012, 06:24 AM

For anyone out there in the future with a similar problem, I've solved it and here's how:
Enabling PDFCreator module in References is required. The code is as follows:

Sub PrintToPDF()
b = Application.InputBox("First Serial :", , , , , , , 2)
If Len(b) = 15 Then 
'Determines that the entered serial number is the right length, 15 in this case
Sheets("1").Range("A1").Value = b
End If
   Dim avarSplit As String
   Dim bvarSplit As Integer
   Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPath As String
    Dim lSheet As Long
    Dim bRestart As Boolean

    avarSplit = Left$(b, 13)
    bvarSplit = Val(Right$(b, 4))
a = Application.InputBox("How many pages would You like to print?:", , , , , , , 1)
If a < 1 Then
MsgBox "Only Chuck Norris can print less than 1 copy at a time and still get stuff printed"
Else: GoTo g
g:

'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator
    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

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


For lSheet = 1 To a


Sheets("1").Select
    If lSheet = 1 Then Sheets("1").Range("A1").Value = b Else: Sheets("1").Range("A1").Value = increment

Sheets("2").Select

            With pdfjob
                '/// Change the output file name here! ///
                sPDFName = Sheets("1").Range("A1") & ".pdf"
                .cOption("UseAutosave") = 1
                .cOption("UseAutosaveDirectory") = 1
                .cOption("AutosaveDirectory") = sPDFPath
                .cOption("AutosaveFilename") = sPDFName
                .cOption("AutosaveFormat") = 0    ' 0 = PDF
                .cClearCache
            End With
            
                
            'Print the document to PDF
            Worksheets("2").PrintOut copies:=1, ActivePrinter:="PDFCreator"
    
            'Wait until the print job has entered the print queue
            Do Until pdfjob.cCountOfPrintjobs = 1
                DoEvents
            Loop
            pdfjob.cPrinterStop = False
    
            'Wait until the file shows up before moving on
            'Important:  Counter must reach zero or hangs on next iteration
            Do Until pdfjob.cCountOfPrintjobs = 0
                DoEvents
         Loop
         bvarSplit = bvarSplit + 1
         increment = avarSplit & Format$(bvarSplit, "0000") 'Return the incremented value
    Next lSheet
    
Cleanup:
    'Release objects and terminate PDFCreator
    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 encountered.  PDFCreator has" & vbCrLf & _
           "has been terminated.  Please try again.", _
           vbCritical + vbOKOnly, "Error"

Resume Cleanup
End If
End Sub