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
Application.Volatile
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
‘breaks
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
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
Application.Volatile
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
‘breaks
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
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.
That’s not the point john, the point is to create something really slick that no-one ever uses :-)
As I read the MSDN Excel blog
Migrating Excel 4 Macros to VBA in
http://blogs.msdn.com/excel/archive/2010/01/27/programmability-improvements-in-excel-2010.aspx
The missing Excel 4 Macro functions will be implemented in Excel 2010 soon if not already ?