Page number "1/3" in C7 that repeats top of each page in a sheet, Excel VBA

Mirkaminer

New Member
Joined
Mar 22, 2022
Messages
7
Office Version
  1. 365
Platform
  1. Windows
I have a workbook with several sheets. On every sheet i repet row 1 to 13 on each page. In cell C7 i want page number and total number of pages in the format of "1/3".

I have found this VBA code to do part of the problem

placed this part in a module

VBA Code:
    Sub PageNumber(MyRange As String)
    Dim iVPC As Integer
    Dim iHPC As Integer
    Dim iVPB As VPageBreak
    Dim iHPB As HPageBreak
    Dim iNumPage As Integer
    iHPC = 1
    iVPC = 1
    If ActiveSheet.PageSetup.Order = xlDownThenOver Then
        iHPC = ActiveSheet.HPageBreaks.Count + 1
    Else
        iVPC = ActiveSheet.VPageBreaks.Count + 1
    End If
    iNumPage = 1
    For Each iVPB In ActiveSheet.VPageBreaks
        If iVPB.Location.Column > ActiveCell.Column Then Exit For
        iNumPage = iNumPage + iHPC
    Next
    For Each iHPB In ActiveSheet.HPageBreaks
        If iHPB.Location.Row > ActiveCell.Row Then Exit For
        iNumPage = iNumPage + iVPC
    Next
    MyRange = "'" & iNumPage & "/" & Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")

    End Sub

placed this part in the sheet object window

VBA Code:
    Private Sub Worksheet_Activate()
        Dim StrString As String
        Call PageNumber(StrString)
        Range("C7:C7").Value = StrString
    End Sub

The part i have problems with is that i need iNumPage (the current page number, not the total number of pages)to update for every page that is going in to print.
Is there a way maybe piggyback riding of the page number function from header and footer, and using it in Private Sub Workbook_BeforePrint or is there another solution. The page number is only for cell C7 because of the repet of row 1-13 on top of each page in print out.
 
I've tweaked it a little but the code works just fine if i have it in a sub an not in "beforeprint".
Got C7 on page one "1/2" and on page two "2/2".
It prints good on a paperprinter, print's once for each page, so a pdf printer prints over previous file (if you don't change the file name) and you can't print on both sides on a paperprinter.

VBA Code:
Sub Print_This_Sheet()
     Dim i, iTot_pages
     Dim lastrow As Long
     Dim LastColumn As Long
     Dim sht As Worksheet
     Set sht = ActiveSheet
     Dim LastColumStr As String

     lastrow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
     LastColumn = sht.Cells(1, sht.Columns.Count).End(xlToLeft).Column
     LastColumStr = getColLet(LastColumn)
     Application.EnableEvents = False                           ' no interference with workbook_BeforePrint !!!!

     With ActiveSheet
          .PageSetup.PrintArea = "A1:" & LastColumStr & lastrow
          .PageSetup.PrintTitleRows = "$1:$13"
          MsgBox "and other pagesetup-setting ....", vbInformation
          iTot_pages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")     '----> normally the number of pages

          For i = 1 To iTot_pages                               'loop through those pages
               .Range("C7").Value = "'" & i & "/" & iTot_pages     'before printing, ajust C7
               .PrintOut i, i, 1, True                          'PrintOut with previeuw page per page'print one page
          Next
     End With

     Application.EnableEvents = True                            'enable events again
End Sub

Public Function getColLet(colNum As Long) As String
Dim i As Long, x As Long
    'If Not isBetween(colNum, 1, Application.Columns.count) Then Exit Function
    For i = Int(Log(CDbl(25 * (CDbl(colNum) + 1))) / Log(26)) - 1 To 0 Step -1
        x = (26 ^ (i + 1) - 1) / 25 - 1
        If colNum > x Then getColLet = getColLet & Chr(((colNum - x - 1) \ 26 ^ i) Mod 26 + 65)
    Next i
End Function
 
Upvote 0

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
mirkaminer.xlsm
well, back to my suggestion in #2.
The pagenumber in the header and then with trial and error adjusting the margins + margins of the header + the header itself with leading spaces.
Then you check your pagesetup in excel (in the ribbon image>page ??), adjust horizontal and vertical page-breaks and finally after (the 1st time) 10 minutes you get a nice printout in 1 time with the right pagenumbers.

VBA Code:
Sub Print_This_Sheet()
     Dim i, iTot_pages
     Dim lastrow As Long
     Dim LastColumn As Long
     Dim sht   As Worksheet

     ipage1 = 5

     Application.EnableEvents = False                           ' no interference with workbook_BeforePrint !!!!
     Set sht = Sheets("Blad1")

     With sht
          lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
          LastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
          .PageSetup.PrintArea = "A1:" & Cells(lastrow, LastColumn).Address
          .PageSetup.PrintTitleRows = "$1:$13"
         If ipage1 > 1 Then .PageSetup.FirstPageNumber = ipage1                       'only if your first page isn't 1 !!!

          iTot_pages = Application.ExecuteExcel4Macro("GET.DOCUMENT(50)")     '----> normally the number of pages
          For i = 3 To LastColumn Step 8
               .Cells(7, i).Value = "               /" & iTot_pages + IIf(ipage1 > 1, ipage1 - 1, 0) 'before printing, ajust C7
          Next
          .PageSetup.FirstPageNumber = 5

          .PrintOut , , , True                                  'PrintOut with previeuw page per page'print one page
     End With

     Application.EnableEvents = True                            'enable events again
End Sub

The red text is the header, the black text is the normal printout
 

Attachments

  • Schermafbeelding 2022-03-30 170359.png
    Schermafbeelding 2022-03-30 170359.png
    6.7 KB · Views: 6
Upvote 0
Yeah, it's probably the only way to solve it. I hoped to find a solution that, when choosing all the sheets, only included the pagination that applied to a specific sheet and not all as it then will be.
 
Upvote 0

Forum statistics

Threads
1,214,813
Messages
6,121,706
Members
449,049
Latest member
THMarana

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top