Returning the page range addresses from a worksheet
2004-10-08 Worksheets 0 181
The custom function below can be used to return a collection of the page ranges in a worksheet. This can be useful when you need to be able to target a spesific page (e.g. when formatting or copying).
Function GetPageRangeAddresses(ws As Worksheet) As Collection ' returns a collection containing the page range addresses of a worksheet Dim h(1 To 2) As Integer, v(1 To 2) As Integer Dim r(1 To 2) As Long, c(1 To 2) As Long Dim strRangeAddress As String, coll As Collection, rngPrintRange As Range If ws Is Nothing Then Exit Function Set coll = New Collection With ws ' determine if a print range is set On Error Resume Next Set rngPrintRange = .Range(.PageSetup.PrintArea) On Error GoTo 0 ' determine the last used cell With .Range("A1").SpecialCells(xlCellTypeLastCell) r(2) = .Row c(2) = .Column End With ' count page breaks (manual+automatic) h(2) = .HPageBreaks.Count v(2) = .VPageBreaks.Count For v(1) = 0 To v(2) For h(1) = 0 To h(2) strRangeAddress = vbNullString ' upper left cell r(1) = 1 c(1) = 1 If h(1) > 0 Then r(1) = .HPageBreaks(h(1)).Location.Row End If If v(1) > 0 Then c(1) = .VPageBreaks(v(1)).Location.Column End If strRangeAddress = .Cells(r(1), c(1)).Address & ":" ' lower right cell r(1) = r(2) c(1) = c(2) If h(1) < h(2) Then r(1) = .HPageBreaks(h(1) + 1).Location.Row - 1 End If If v(1) < v(2) Then c(1) = .VPageBreaks(v(1) + 1).Location.Column - 1 End If strRangeAddress = strRangeAddress & .Cells(r(1), c(1)).Address ' add the range to the collection that the function will return If Not rngPrintRange Is Nothing Then ' a print range is set ' return only the range intersecting the print range strRangeAddress = Intersect(.Range(strRangeAddress), rngPrintRange).Address End If On Error Resume Next coll.Add strRangeAddress, strRangeAddress On Error GoTo 0 Next h(1) Next v(1) End With If coll.Count > 0 Then Set GetPageRangeAddresses = coll End If Set rngPrintRange = Nothing Set coll = Nothing End Function Sub TestGetPageRangeAddresses() Dim coll As Collection, i As Integer, strResult As String If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub Set coll = GetPageRangeAddresses(ActiveSheet) If coll Is Nothing Then Exit Sub strResult = vbNullString For i = 1 To coll.Count ' contains the cell range address for each page strResult = strResult & "Page " & i & ": " & coll(i) & vbLf Next i MsgBox strResult, vbInformation, "Page Ranges in " & ActiveSheet.Name Set coll = Nothing End Sub