excelvbapage-numbering

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


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

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

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.


Solution

  • I've asked this question on another site and this was as close we could get, but it's not a good solution because of the handling of print property's, the documents prints once for each page and that will cause trouble if you what print on both sides or in a pdf file.

    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
    

    Contributor to this solution mcranmoss, the function is from a previous project so it's from somewhere....