Excel visual basic macro generates table of contents

Excel visual basic macro generates table of contents that has one entry per worksheet.

download excel file

   1:rem Eric Mariacher
   2:rem generate some charts and build a table of contents as 1st worksheet
   3:Sub charts and TOC()
   4:    Dim ws As Worksheet
   5:    Dim cpt, cptpoint As Long
   6:    Dim color_index As Long
   7:    For Each ws In ActiveWorkbook.Worksheets
   8:        ActiveWorkbook.Activate
   9:        ws.Select
  10:        ws.Activate
  11:        Worksheets.Add
  12:        With ActiveSheet
  13:            .Name = "G" + ws.Name
  14:            Rem ch = .Controls.AddChart("B2:F7", "tagada")
  15:        End With
  16:        Charts.Add
  17:        ActiveChart.ChartType = xlColumnStacked
  18:        ActiveChart.SetSourceData Source:=Range(ws.Name), PlotBy:=xlColumns
  19:        With ActiveChart
  20:            .HasTitle = True
  21:            .ChartTitle.Characters.Text = ws.Name
  22:          
  23:            cpt = 1
  24:            For cpt = 1 To .SeriesCollection.Count
  25:                Select Case cpt
  26:                    Case 1
  27:                        color_index = 1
  28:                    Case 2
  29:                        color_index = 9
  30:                End Select
  31:                .SeriesCollection(cpt).Interior.ColorIndex = color_index
  32:            Next cpt
  33:        End With
  34:        ActiveChart.Location Where:=xlLocationAsObject, Name:="G" + ws.Name
  35:        With Worksheets("G" + ws.Name)
  36:            .ChartObjects(1).Width = 900
  37:            .ChartObjects(1).Height = 600
  38:            .ChartObjects(1).Left = .Columns("A").Left
  39:            .ChartObjects(1).Top = .Rows("2").Top
  40:        End With
  41:    Next ws
  42:  
  43:    Dim wsTOC As Worksheet
  44:    Dim Chart As Chart
  45:    Dim r As Long
  46:    Application.ScreenUpdating = False
  47:    Set wsTOC = ActiveWorkbook.Worksheets.Add _
  48:         (Before:=ActiveWorkbook.Sheets(1))
  49:    wsTOC.Name = "Table_of_Contents"
  50:    wsTOC.Range("A1") = "Table of Contents"
  51:    wsTOC.Range("A1").Font.Size = 18
  52:    wsTOC.Columns("A:A").ColumnWidth = 40
  53:    r = 3
  54:    For Each ws In ActiveWorkbook.Worksheets
  55:        If ws.Name <> wsTOC.Name And ws.Name Like "G*" Then
  56:            wsTOC.Hyperlinks.Add _
  57:                anchor:=wsTOC.Cells(r, 1), _
  58:                Address:="", _
  59:                SubAddress:=ws.Name & "!A1", _
  60:                TextToDisplay:=ws.Name
  61:            r = r + 1
  62:            ws.Hyperlinks.Add _
  63:                anchor:=ws.Cells(1, 1), _
  64:                Address:="", _
  65:                SubAddress:="Table_of_Contents!A1", _
  66:                TextToDisplay:="Table of Contents"
  67:        End If
  68:    Next
  69:    Application.ScreenUpdating = True
  70:End Sub