Microsoft Office Tutorials and References
In Depth Information
Creating a Table of Contents of a Workbook
'See if a table of contents sheet already exists¶
On Error Resume Next¶
Set WS = ActiveWorkbook.Sheets(Contents)¶
On Error GoTo 0¶
'Turn off screen updating¶
Application.ScreenUpdating = False¶
If Not WS Is Nothing Then¶
'Not WS Is Nothing is code for "Worksheet exists"¶
'Ask if it should be overwritten¶
If MsgBox( _¶
Prompt:="Do you want to overwrite the current " & _¶
Contents & " ?", _¶
Buttons:=vbQuestion + vbYesNo) = vbNo Then¶
Exit Sub¶
End If¶
WS.Activate¶
Else¶
'Add the sheet¶
Set WS = ActiveWorkbook.Worksheets.Add( _¶
Before:=ActiveWorkbook.Sheets(1))¶
WS.Name = Contents¶
End If¶
'Format the sheet¶
WS.Cells.Delete¶
WS.Range("B1").Value = Contents¶
WS.Range("B1").Font.Bold = True¶
WS.Range("B1").Font.Size = 12¶
WS.Range("A1").EntireColumn.ColumnWidth = 5¶
WS.Range("A1").EntireColumn.HorizontalAlignment = xlCenter¶
WS.Range("B1").EntireColumn.ColumnWidth = 45¶
'Create the table¶
For Each Sht In ActiveWorkbook.Worksheets¶
If Not Sht Is WS Then¶
'Not Sht Is WS is code for "the sheet is not WS"¶
'Check all the worksheets except WS¶
'Now, add the Sht reference to WS¶
With WS.Cells(WS.Rows.Count, 2).End(xlUp).Offset(1)¶
.Value = Sht.Name¶
WS.Hyperlinks.Add Anchor:=.Item(1), Address:="", _¶
SubAddress:="'" & Sht.Name & "'!A1"¶
'Add a bullet in column A¶
.Offset(, -1).Value = Chr$(149)¶
End With¶
End If¶
Next Sht¶
'Restore screen updating¶
Application.ScreenUpdating = True¶
End Sub¶
Exl
Search JabSto ::




Custom Search