Hi,
I'm working on a large spreadsheet with plenty of worksheets.
Is it possible to have a macro that creates a content page?
ie. In a column on the current worksheet, it will place the names of all the worksheets and hyperlinks to all the worksheets.
I found the following code online and it does most of the work, except for placing the hyperlink. Can anyone help?
I'm working on a large spreadsheet with plenty of worksheets.
Is it possible to have a macro that creates a content page?
ie. In a column on the current worksheet, it will place the names of all the worksheets and hyperlinks to all the worksheets.
I found the following code online and it does most of the work, except for placing the hyperlink. Can anyone help?
Code:
Sub GenerateTableOfContents()
' Does a TOC already exist?
' If Err system variable is > 0, it doesn't
Dim wSheet As Worksheet
On Error Resume Next
Set wSheet = Worksheets("Table of Contents")
If Not Err = 0 Then
' The Table of contents doesn't exist. Add it
Set wSheet = Worksheets.Add(Before:=Worksheets(1))
wSheet.Name = "TOC"
End If
On Error GoTo 0
' Set up the table of contents page
wSheet.[A2] = "Table of Contents"
With wSheet.[A6]
.CurrentRegion.Clear
.Value = "Subject"
End With
wSheet.[B6] = "Page(s)"
wSheet.Range("A1:B1").ColumnWidth = Array(36, 12)
TableRow = 7
PageCount = 0
Worksheets.Select
displayMessage = "We'll do a Print Preview for some calculations."
displayMessage = displayMessage & "Please ‘Close' the window when it appears."
MsgBox displayMessage
ActiveWindow.SelectedSheets.PrintPreview
' Now loop thru sheets, collecting TOC info
For Each S In Worksheets
S.Select
ThisName = S.Name
HPages = S.HPageBreaks.Count + 1
VPages = S.VPageBreaks.Count + 1
ThisPages = HPages * VPages
' Enter info about this sheet on TOC
wSheet.Cells(TableRow, 1).Value = ThisName
wSheet.Cells(TableRow, 2).NumberFormat = "@"
If ThisPages = 1 Then
wSheet.Cells(TableRow, 2).Value = PageCount + 1 & " "
Else
wSheet.Cells(TableRow, 2).Value = PageCount + 1 & " - " & PageCount + ThisPages
End If
PageCount = PageCount + ThisPages
TableRow = TableRow + 1
Next S
End Sub