• If you would like to post, please check out the MrExcel Message Board FAQ and click here to register.
    If you forgot your password, you can reset your password.
  • Excel articles and downloadable files provided in the articles have not been reviewed by MrExcel Publishing. Please apply the provided methods / codes and open the files at your own risk.
    If you have any questions regarding an article, please use the Article Discussion section.
Worf

Worksheet page addresses with VBA

Sometimes we need to know the addresses of all the pages that make up a worksheet. The code below lists them and offers an option to colour each page differently.

wspages.JPG


VBA Code:
Sub Main2()
PageAddress2 True
End Sub

Sub PageAddress2(colorcode As Boolean)
Dim c%, v%, h%, cln%, rw%, hgth%, wth%, i%, ws As Worksheet
Set ws = ActiveSheet
c = 1: s = ""
ActiveWindow.View = xlPageBreakPreview
ws.PageSetup.PrintArea = ""
ws.PageSetup.PrintArea = ws.UsedRange.Address                               ' force page break recalculation
ReDim Preserve pag(1 To (ws.VPageBreaks.count + 1) * (ws.HPageBreaks.count + 1))     'all pages on that sheet
For v = 0 To ws.VPageBreaks.count
    For h = 0 To ws.HPageBreaks.count
        If v = ws.VPageBreaks.count Then
            wth = ws.UsedRange.Columns(ws.UsedRange.Columns.count).Column
        Else
            wth = ws.VPageBreaks(v + 1).Location.Column - 1
        End If
        If h = ws.HPageBreaks.count Then
            hgth = ws.UsedRange.Rows(ws.UsedRange.Rows.count).Row
        Else
            hgth = ws.HPageBreaks(h + 1).Location.Row - 1
        End If
        If v = 0 Then
            cln = 1
        Else
            cln = ws.VPageBreaks(v).Location.Column
        End If
        If h = 0 Then
            rw = 1
        Else
            rw = ws.HPageBreaks(h).Location.Row
        End If
        Set pag(c) = ws.Range(ws.Cells(rw, cln).Address & ":" & ws.Cells(hgth, wth).Address)     ' page address
        s = s & pag(c).Address & vbLf
        If colorcode Then pag(c).Interior.Color = RGB(CInt(250 * Rnd), CInt(250 * Rnd), CInt(250 * Rnd))
        c = c + 1
    Next
Next
MsgBox s
End Sub
Excel Version
2013
Author
Worf
Views
272
First release
Last update
Rating
0.00 star(s) 0 ratings

More Excel articles from Worf

Some videos you may like

This Week's Hot Topics

Top