Back
Excel

Add a Table of Contents to your Workbook Programmatically

Today’s author is MVP Bill Jelen of MrExcel.com.

The following code example verifies that a sheet named “TOC” already exists. If it exists, the example updates the table of contents. Otherwise, the example creates a new TOC sheet at the beginning of the workbook. The name of each worksheet, along with the corresponding printed page numbers, is listed in the table of contents. To retrieve the page numbers the example opens the Print Preview dialog box. You must close the dialog box and then the table of contents is created.

 Sub CreateTableOfContents()
    ‘ Determine if there is already a Table of Contents
    ‘ Assume it is there, and if it is not, it will raise an error
    ‘ if the Err system variable is > 0, you know the sheet is not there
    Dim WST As Worksheet
    On Error Resume Next
    Set WST = Worksheets(“TOC”)
    If Not Err = 0 Then
        ‘ The Table of contents doesn’t exist. Add it
        Set WST = Worksheets.Add(Before:=Worksheets(1))
        WST.Name = “TOC”
    End If
    On Error GoTo 0
   
    ‘ Set up the table of contents page
    WST.[A2] = “Table of Contents”
    With WST.[A6]
        .CurrentRegion.Clear
        .Value = “Subject”
    End With
    WST.[B6] = “Page(s)”
    WST.Range(“A1:B1″).ColumnWidth = Array(36, 12)
    TOCRow = 7
    PageCount = 0

    ‘ Do a print preview on all sheets so Excel calcs page breaks
    ‘ The user must manually close the PrintPreview window
    Msg = “Excel needs to do a print preview to calculate the number of pages. “
    Msg = Msg & “Please dismiss the print preview by clicking close.”
    MsgBox Msg
    ActiveWindow.SelectedSheets.PrintPreview

    ‘ Loop through each sheet, collecting TOC information
    For Each S In Worksheets
        If S.Visible = -1 Then
            S.Select
            ThisName = ActiveSheet.Name
            HPages = ActiveSheet.HPageBreaks.Count + 1
            VPages = ActiveSheet.VPageBreaks.Count + 1
            ThisPages = HPages * VPages

            ‘ Enter info about this sheet on TOC
            Sheets(“TOC”).Select
            Range(“A” & TOCRow).Value = ThisName
            Range(“B” & TOCRow).NumberFormat = “@”
            If ThisPages = 1 Then
                Range(“B” & TOCRow).Value = PageCount + 1 & ” “
            Else
                Range(“B” & TOCRow).Value = PageCount + 1 & ” – ” & PageCount + ThisPages
            End If
        PageCount = PageCount + ThisPages
        TOCRow = TOCRow + 1
        End If
    Next S
End Sub