Exract individual page ranges from sheet

  • Thread starter Thread starter xp
  • Start date Start date
X

xp

Using Excel 2007 and Win XP;

I have several pages delineated by page breaks all residing in one sheet. I
am trying to obtain the cell address of, say, page 3. I figure this would be
the range address of the top left cell and bottom right cell in the range of
page 3 (which can most easily be seen in PageBreakPreview).

I tried using PrintArea, but that gives me the print range of the entire
sheet, I just need one page (I need to be able to get any individual page).
Can anyone please post some code that will enable me to do this?

Thanks much in advance.
 
Give the following function a try (it will only work in XL2007); just pass
in the page number whose address you want to find and optionally specify the
worksheet name (the function will default to the ActiveSheet if nothing is
passed into this argument).

Public Function PageAddress(PageNumber As Long, _
Optional SheetName As String) As String
Dim WS As Worksheet
Dim X As Long
Dim TopRow As Long, BottomRow As Long
Dim LeftCol As Long, RightCol As Long
Dim LastUsedRow As Long, LastUsedCol As Long
Dim LeftEdgeIndex As Long, TopEdgeIndex As Long
Dim TopEdges() As Long, LeftEdges() As Long
If Len(SheetName) = 0 Then
Set WS = ActiveSheet
Else
Set WS = Worksheets(SheetName)
End If
If PageNumber > WS.PageSetup.Pages.Count Then
PageAddress = "No Such Page Number!"
Exit Function
End If
On Error GoTo EmptySheet
LastUsedRow = WS.Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious).Row
LastUsedCol = WS.Cells.Find(What:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo PageNumberError
ReDim TopEdges(1 To WS.VPageBreaks.Count + 2)
ReDim LeftEdges(1 To WS.HPageBreaks.Count + 2)
TopEdges(1) = 1
LeftEdges(1) = 1
TopEdges(UBound(TopEdges)) = LastUsedCol + 1
LeftEdges(UBound(LeftEdges)) = LastUsedRow + 1
For X = 1 To WS.HPageBreaks.Count
LeftEdges(X + 1) = WS.HPageBreaks(X).Location.Row
Next
For X = 1 To WS.VPageBreaks.Count
TopEdges(X + 1) = WS.VPageBreaks(X).Location.Column
Next
TopEdgeIndex = 1 + ((PageNumber - 1) \ (WS.HPageBreaks.Count + 1))
LeftEdgeIndex = 1 + ((PageNumber - 1) Mod (WS.HPageBreaks.Count + 1))
PageAddress = Cells(LeftEdges(LeftEdgeIndex), TopEdges(TopEdgeIndex)). _
Address & ":" & Cells(LeftEdges(LeftEdgeIndex + 1), _
TopEdges(TopEdgeIndex + 1)).Offset(-1, -1).Address
Exit Function
EmptySheet:
PageAddress = "No Data On Sheet!"
Exit Function
PageNumberError:
PageAddress = "Page Numbering Error!"
End Function
 
Hold off on using this function... there are some additional conditions that
need to be accounted for in order to make it work correctly under all
situations. Hopefully, I will post a new function later today (Eastern
Daylight Time); but, if not, then I should be able to post one tomorrow at
the latest.
 
I'm still working on it (off and on), but there is a lot to the problem,
mostly having to do with how Print Areas affects the page numbering
(especially relating to non-contiguous print areas, ordering of print area
ranges and print areas not starting at A1). I'm making progress, but will
need a little more time. Keep checking back... I'm guessing I'll need a
couple or so more days.
 
Okay, thanks!


Rick Rothstein said:
I'm still working on it (off and on), but there is a lot to the problem,
mostly having to do with how Print Areas affects the page numbering
(especially relating to non-contiguous print areas, ordering of print area
ranges and print areas not starting at A1). I'm making progress, but will
need a little more time. Keep checking back... I'm guessing I'll need a
couple or so more days.
Click to expand...
 
I have not forgotten about you or your question, but there will be a delay
before I can seriously work on it. Something happened to my main system and
I am no longer able to read or send email and newsgroups messages any more
(I'm writing this on my laptop). I have spent almost a week now trying to
save my system, but nothing I have done has worked. It is beginning to look
like I'll have to format my hard drives and reinstall everything all over
again. That will take some time to do and, obviously, will be a priority for
me. Right now I am making sure I have all my individual data backed up. I
may be able to work on your problem from my laptop as time permits, but all
my useful stuff is on my desktop computer (it has much more storage space
than my laptop). I'm sorry to have to put you off like this... you question
poses an interesting problem which I am anxious to work on. If you want, you
can send me an email (remove the NO.SPAM stuff) and I'll keep you update
privately (and yes to those other readers of this thead... I'll post any
solution I come up with back here in this thread too).
 
Back
Top