Dynamic Table of Contents

  • Thread starter Thread starter PRGMRgirl
  • Start date Start date
P

PRGMRgirl

Hi Everyone,

I have a workbook that has 28 sheets. This workbook is meant to be
printed out. Several of the sheets run for more than one page. For
example, sheet 5 may be made up of 3 pages. Because the information is
pulled from a database automatically, the number of pages per sheet
varies.

I would like to create a dynamic TOC that counts the pages of each
sheet and displays it. For example:

Contractors ..............................pages 10-15
Vendors....................................pages 16-18

And so on. Anyone have any ideas of an easy way to do this?

Thanks!

Frankie
 
The code below assumes that pagebreak settings are already
'effective' / 'initialized' (or whatever the correct terminology is).

You will have to adapt the code below to suit your aesthetic needs.

Option Explicit
Option Base 0
Type SheetData
SheetName As String
PageCount As Integer
End Type
Sub Macro5()
Dim i As Integer, aSheet As Object, WbkData() As SheetData
ReDim WbkData(ActiveWorkbook.Sheets.Count - 1)
On Error Resume Next
For i = 1 To ActiveWorkbook.Sheets.Count
With Sheets(i)
WbkData(i - 1).PageCount = _
(.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1)
WbkData(i - 1).SheetName = .Name
End With
If Err.Number <> 0 Then WbkData(i - 1).PageCount = -1
Err.Clear
Next i
On Error GoTo 0
Dim NewWKS As Worksheet
Set NewWKS = ActiveWorkbook.Worksheets.Add()
For i = LBound(WbkData) To UBound(WbkData)
With NewWKS.Cells(1, 1)
.Offset(i + 1, 0).Value = WbkData(i).SheetName
.Offset(i + 1, 1).Value = WbkData(i).PageCount
.Offset(i + 1, 2).Value = _
Application.WorksheetFunction.Max(1, _
.Offset(i, 2).Value + .Offset(i, 1).Value)
End With
Next i
With NewWKS.Cells(1, 1)
.Offset(0, 0).Value = "Name"
.Offset(0, 1).Value = "Pages"
.Offset(0, 2).Value = "Start Page"

End With
End Sub

If page break data is not updated, adapt the ideas in the code below to
'initialize' each sheet in the workbook.

Sub Macro6()
Dim InitView, InitShowPageBreak
InitView = ActiveWindow.View
ActiveWindow.View = xlNormalView
InitShowPageBreak = ActiveSheet.DisplayAutomaticPageBreaks
ActiveSheet.DisplayAutomaticPageBreaks = True
ActiveWindow.View = xlPageBreakPreview
ActiveWindow.View = InitView
ActiveSheet.DisplayAutomaticPageBreaks = InitShowPageBreak
End Sub

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
Back
Top