Get Pages Ranges of PrintArea

[Gatti]

Hello!!!

Is there any way to get ranges of pages in PrintArea?

Using the default Worksheets("Sheet1").PageSetup.PrintArea only returns the full print area worksheet.

I need to know where the "page breaks" and where the next page starts.

Thanks!!

[Greg M]

Hi there,

See if the following code gets you moving in the right direction:

Option Explicit


Sub LocatePageBreaks()

    Dim iNoOfPageBreaks As Integer
    Dim iLastRowOnSheet As Integer
    Dim iPageBreakNo    As Integer
    Dim vaPageRanges    As Variant
    Dim iRowNo_First    As Integer
    Dim iRowNo_Last     As Integer
    Dim sPagesList      As String
    Dim rPage           As Range
    Dim wks             As Worksheet

    Set wks = ActiveSheet

    With wks
        iLastRowOnSheet = .UsedRange.Rows(.UsedRange.Rows.Count).Row
    End With

    iNoOfPageBreaks = wks.HPageBreaks.Count

    iRowNo_First = 1

    If iNoOfPageBreaks > 0 Then

'         The worksheet contains multiple pages
          ReDim vaPageRanges(1 To iNoOfPageBreaks)

          For iPageBreakNo = 1 To iNoOfPageBreaks

              iRowNo_Last = wks.HPageBreaks(iPageBreakNo).Location.Row - 1

              With wks
                  Set rPage = Range(.Rows(iRowNo_First), _
                                    .Rows(iRowNo_Last))
              End With

              Set vaPageRanges(iPageBreakNo) = rPage

              iRowNo_First = iRowNo_Last + 1

          Next iPageBreakNo

    Else:

'         The worksheet contains only a single page
          With wks
              Set rPage = Range(.Rows(iRowNo_First), _
                                .Rows(iLastRowOnSheet))
          End With

          ReDim vaPageRanges(1 To 1)

          Set vaPageRanges(1) = rPage

    End If

'   Determine whether or not the worksheet contains used rows after the last PageBreak
    If iNoOfPageBreaks > 0 And _
       iLastRowOnSheet > iRowNo_Last Then

'       If so, add the last page to the array of pages
        With wks
            Set rPage = Range(.Rows(iRowNo_First), _
                              .Rows(iLastRowOnSheet))
        End With

        ReDim Preserve vaPageRanges(1 To UBound(vaPageRanges) + 1)

        Set vaPageRanges(UBound(vaPageRanges)) = rPage

    End If

'   Display the list of page ranges
    sPagesList = vbNullString

    For iPageBreakNo = LBound(vaPageRanges) To UBound(vaPageRanges)

        sPagesList = sPagesList & _
                     vbLf & _
                     vbTab & vbTab & vaPageRanges(iPageBreakNo).Address

    Next iPageBreakNo

    MsgBox "The worksheet """ & wks.Name & """ contains the following " & _
           "page row range(s):" & _
            vbLf & _
            sPagesList

End Sub

Hope this helps - please let me know how you get on.

Regards,

Greg M

[Gatti]

Hey Greg! I'm sorry: took to long to reply... didn't enter the forum for almost a month

It worked great! Thanks for your solution!

[Greg M]

Hi again,

Many thanks for your feedback and also for the Reputation increase - much appreciated

You're welcome - glad I was able to hep.

Best regards,

Greg M