?
Solved

Unique page number for each page in workbook when printed simultaneously.

Posted on 2014-07-14
8
Medium Priority
?
201 Views
Last Modified: 2014-07-14
I have a workbook with seven worksheets.
Each worksheet has one unique print area.
I have a macro that prints all these "pages" simultaneously.
When footers are all formatted "Page &[Page] of &[Pages]" it results in all pages numbered "Page 1 of 1".
When footers are all formatted "Page 1 of 7" it results in all pages numbered "Page 1 of 7".
How can I have the first page print "Page 1 of 7" , the second page print "Page 2 of 7" and so on.
How can I do that?

[I can perhaps name the tabs  "Page 1 of 7" , etc. and then have the tab names printed in place of page numbers, but I would like to have some other way of determining the page number. (For user friendlyness.)]
0
Comment
Question by:Fritz Paul
  • 4
  • 4
8 Comments
 
LVL 28

Expert Comment

by:MacroShadow
ID: 40193965
I believe your macro can be amended. Please attach it.
0
 

Author Comment

by:Fritz Paul
ID: 40193970
Option Explicit
'http://www.excelguru.ca/content.php?161


Sub PrintToPDF_SpecifiedSheetsToOne_Early()
'Print Specified Worksheets to a Single PDF File
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
'   (Download from http://sourceforge.net/projects/pdfcreator/)
'   Designed for early bind, set reference to PDFCreator

    Dim pdfjob As PDFCreator.clsPDFCreator
    Dim sPDFName As String
    Dim sPDFPath As String
    Dim sSheetsToPrint As String
    Dim sSheets() As String
    Dim lSheet As Long
    Dim lTtlSheets As Long
    Dim bRestart As Boolean
    Dim sClient As String
    Dim BeginDate As Date
    Dim EndDate As Date
    Dim sBeginDate As String 'This is to include date as string in right format.
    Dim sEndDate As String 'This is to include date as string in right format.

    

    '/// Change the output file name here! ///
'    sPDFName = "Consolidated.pdf"
    BeginDate = Worksheets("Detail").Range("a7:a7").Value
    sBeginDate = Year(BeginDate) & "_" & Right("0" & Month(BeginDate), 2) & "_" & Right("0" & Day(BeginDate), 2)

    EndDate = Worksheets("Detail").Range("b7:b7").Value
    sEndDate = Year(EndDate) & "_" & Right("0" & Month(EndDate), 2) & "_" & Right("0" & Day(EndDate), 2)
    
    sClient = Worksheets("Detail").Range("d3:d3").Value
    sPDFName = sClient & " Summary Portfolio Valuation " & sBeginDate & " - " & sEndDate & ".pdf"
'    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator
    sPDFPath = "C:/StehanReports/"
Application.Cursor = xlWait

'    'Delete the PDF if it already exists
    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)
    
    '/// Record the sheets you want to print here! ///
    '/// Use sheet names separated by commas only, no spaces befor or after the commas.  ///
    sSheetsToPrint = "Cover Page,Net Position,Position Level Information,Performance Analysis,Income Analysis,Investment Projections,Notes & Disclaimer"
    'Activate error handling and turn off screen updates
    On Error GoTo EarlyExit
    Application.ScreenUpdating = False
    Set pdfjob = New PDFCreator.clsPDFCreator

    '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

    'Assign settings for PDF job
    With pdfjob
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sPDFPath
        .cOption("AutosaveFilename") = sPDFName
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With
    
    
    'Split the sheets into an array
    sSheets() = Split(sSheetsToPrint, ",")

'    'Delete the PDF if it already exists
'    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)

    'Print the document to PDF
    For lSheet = LBound(sSheets) To UBound(sSheets)
        On Error Resume Next 'To deal with chart sheets
        If Not IsEmpty(Application.Sheets(sSheets(lSheet)).UsedRange) Then
            Application.Sheets(sSheets(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
            lTtlSheets = lTtlSheets + 1
        End If
        On Error GoTo EarlyExit
    Next lSheet

    'Wait until all print jobs have entered the print queue
    Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
        DoEvents
    Loop

    'Combine all PDFs into a single file and stop the printer
    With pdfjob
        .cCombineAll
        .cPrinterStop = False
    End With

    'Wait until the file shows up before closing PDF Creator
    Do
        DoEvents
    Loop Until Dir(sPDFPath & sPDFName) = sPDFName
    
    Application.Cursor = xlDefault
    MsgBox "Process has been completed"
    GoTo Cleanup

Cleanup:
    'Release objects and terminate PDFCreator
    Set pdfjob = Nothing
    Shell "taskkill /f /im PDFCreator.exe", vbHide
    On Error GoTo 0
    Application.ScreenUpdating = True
    Application.Cursor = xlDefault
'    MsgBox "Process has been completed"
    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 Sub

Sub PrintToPDF_MultiSheetToOne_Early()
'Author       : Ken Puls (www.excelguru.ca)
'Macro Purpose: Print to PDF file using PDFCreator
'   (Download from http://sourceforge.net/projects/pdfcreator/)
'   Designed for early bind, set reference to PDFCreator

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

    '/// Change the output file name here! ///
    sPDFName = "Consolidated1.pdf"
    sPDFPath = ActiveWorkbook.Path & Application.PathSeparator

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

    '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

    'Assign settings for PDF job
    With pdfjob
        .cOption("UseAutosave") = 1
        .cOption("UseAutosaveDirectory") = 1
        .cOption("AutosaveDirectory") = sPDFPath
        .cOption("AutosaveFilename") = sPDFName
        .cOption("AutosaveFormat") = 0    ' 0 = PDF
        .cClearCache
    End With
    
    'Delete the PDF if it already exists
    If Dir(sPDFPath & sPDFName) = sPDFName Then Kill (sPDFPath & sPDFName)

    'Print the document to PDF
'    lTtlSheets = Application.Sheets.Count
    lTtlSheets = 2
'    For lSheet = 1 To Application.Sheets.Count
    For lSheet = 4 To lTtlSheets
        On Error Resume Next 'To deal with chart sheets
        If Not IsEmpty(Application.Sheets(lSheet).UsedRange) Then
            Application.Sheets(lSheet).PrintOut copies:=1, ActivePrinter:="PDFCreator"
        Else
            lTtlSheets = lTtlSheets - 1
        End If
        On Error GoTo EarlyExit
    Next lSheet

    'Wait until all print jobs have entered the print queue
    Do Until pdfjob.cCountOfPrintjobs = lTtlSheets
        DoEvents
    Loop

    'Combine all PDFs into a single file and stop the printer
    With pdfjob
        .cCombineAll
        .cPrinterStop = False
    End With

    'Wait until the file shows up before closing PDF Creator
    Do
        DoEvents
    Loop Until Dir(sPDFPath & sPDFName) = sPDFName

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 Sub

Open in new window

0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 40193980
Search for and replace the following section.
    'Print the document to PDF
    For lSheet = LBound(sSheets) To UBound(sSheets)
        On Error Resume Next    'To deal with chart sheets
        If Not IsEmpty(Application.Sheets(sSheets(lSheet)).UsedRange) Then
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
            ' This is the line I added. Change A1 to the cell containing the footer.
            Sheets(sSheets(lSheet)).Range("A1").Value = "Page " & lSheet & " of " & UBound(sSheets)
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''           
            Application.Sheets(sSheets(lSheet)).PrintOut copies:=1, ActivePrinter:="PDFCreator"
            lTtlSheets = lTtlSheets + 1
        End If
        On Error GoTo EarlyExit
    Next lSheet

Open in new window

0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:Fritz Paul
ID: 40194130
Thanks. However some mis communication.

To clarify.

In my Page setup I have i  the footer section.
'Page &[Page] of &[Pages]" it results in all pages numbered "Page 1 of 1".
I can change that to "Page &[Page] of 7", but that will make all Page 1 of 7.
How can I modify the value of   "&[Page]" ?
Say I can somehow say [Page].value = A1.
Then I could insert in A1 the appropriate page number.
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 40194184
In my Page setup I have i  the footer section.
'Page &[Page] of &[Pages]" it results in all pages numbered "Page 1 of 1".
And it always will, since each sheet has only one page.

My suggestion is to manually create the footer. The code I posted will do that assuming you change A1 to whichever cell you want the footer in.

An alternative is to copy all sheets to one sheet, then you will get the page numbers you want using the built-in footer.
0
 

Author Comment

by:Fritz Paul
ID: 40194249
Thanks again.
One more try.
Is there no way like the code that you supplied:
Sheets(sSheets(lSheet)).Range("A1").Value = "Page " & lSheet & " of " & UBound(sSheets)

Open in new window

to turn it around and change the value of [Page] to lSheet or to the value of soem cell value?
There are some consequences if i put all the sheets on one page, for example the number of columns and width of columns.
0
 
LVL 28

Accepted Solution

by:
MacroShadow earned 1500 total points
ID: 40194251
No Page and Pages are internal Excel read only variables.
0
 

Author Closing Comment

by:Fritz Paul
ID: 40194304
Thanks a lot.
It seems clear that, in my case, the only alternative is unique on page footers.
Regards,
Fritz
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

850 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question