VBA Page of Pages in a Cell

In Page of Pages in a Cell, Jan Karel uses defined names and Excel 4 Macro commands to return the current page and total pages in a workbook. The problem is that it doesn’t work properly when the cell is repeated (e.g. File – Page Setup – Sheet – Rows to Repeat at Top). So I set about writing a VBA function that would do the same work.

Like Jan Karel’s, mine doesn’t work with repeated cells either. I don’t know why I thought it would. Once I was done with it and tested it, it became pretty obvious that it wasn’t going to work. Unlike Jan Karel’s, mine is really, really slow.

So why post it? Because I spent a bunch of time on it, that’s why. They can’t all be winners.

Function ThisPageNum() As Long
    Dim rCell As Range
    Dim vpb As VPageBreak
    Dim lVert As Long, lVertCount As Long
    Dim hpb As HPageBreak
    Dim lHoriz As Long, lHorizCount As Long
    Dim lReturn As Long
    Set rCell = Application.Caller
    lReturn = 1 ‘if everything fails, return 1
    ‘If there are no page breaks, 1 will be returned
   If ActiveSheet.VPageBreaks.Count > 0 Then
        lVert = ActiveSheet.VPageBreaks.Count + 1 ‘the last vertical page in case
                                                 ‘is one more than the last page
       For Each vpb In ActiveSheet.VPageBreaks
            lVertCount = lVertCount + 1
            With ActiveSheet
                ‘if the cell is left of the break, count it
               If Not Intersect(rCell, .Range(.Cells(1, 1), _
                    .Cells(1, vpb.Location.Column)).EntireColumn) Is Nothing Then
                    lVert = lVertCount
                    Exit For
                End If
            End With
        Next vpb
        ‘All the same as above, just 90 degrees different
       lHoriz = ActiveSheet.HPageBreaks.Count + 1
        For Each hpb In ActiveSheet.HPageBreaks
            lHorizCount = lHorizCount + 1
            If Not Intersect(rCell, ActiveSheet.Range(“1:” & hpb.Location.Row)) Is Nothing Then
                lHoriz = lHorizCount
                Exit For
            End If
        Next hpb
        ‘Convert lvert and lhoriz into real page numbers
       lReturn = ((lVert – 1) * (ActiveSheet.HPageBreaks.Count + 1)) + lHoriz
    End If
    ThisPageNum = lReturn
End Function
Posted in Uncategorized

3 thoughts on “VBA Page of Pages in a Cell

  1. Add 5-6 formulas that use that function and things slow to a crawl. Or maybe it’s dependent on your printer driver?

    JK’s XLM method continues to work in Excel 2010 Beta. But I still can’t think of any reason to actually use it.

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published.