Agregar una tabla de contenido a un libro

En los siguientes ejemplos se muestran diferentes métodos para agregar una tabla de contenido a un libro de Excel.

Código de ejemplo proporcionado por: Dennis Wallentin, VSTO & .NET & Excel

En este ejemplo se usa la propiedad Pages.Count (Excel) para calcular el número de páginas de cada hoja. Además, se vinculan las entradas de la tabla de contenido con sus respectivas hojas para la exploración del libro en pantalla.

Option Explicit 
Sub Create_TOC() 
Dim wbBook As Workbook 
Dim wsActive As Worksheet 
Dim wsSheet As Worksheet 
Dim lnRow As Long 
Dim lnPages As Long 
Dim lnCount As Long 
Set wbBook = ActiveWorkbook 
With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With 
'If the TOC sheet already exist delete it and add a new 
'worksheet. 
On Error Resume Next 
With wbBook 
    .Worksheets("TOC").Delete 
    .Worksheets.Add Before:=.Worksheets(1) 
End With 
On Error GoTo 0 
Set wsActive = wbBook.ActiveSheet 
With wsActive 
    .Name = "TOC" 
    With .Range("A1:B1") 
        .Value = VBA.Array("Table of Contents", "Sheet # - # of Pages") 
        .Font.Bold = True 
    End With 
End With 
lnRow = 2 
lnCount = 1 
'Iterate through the worksheets in the workbook and create 
'sheetnames, add hyperlink and count & write the running number 
'of pages to be printed for each sheet on the TOC sheet. 
For Each wsSheet In wbBook.Worksheets 
    If wsSheet.Name <> wsActive.Name Then 
        wsSheet.Activate 
        With wsActive 
            .Hyperlinks.Add .Cells(lnRow, 1), "", _ 
            SubAddress:="'" & wsSheet.Name & "'!A1", _ 
            TextToDisplay:=wsSheet.Name 
            lnPages = wsSheet.PageSetup.Pages().Count 
            .Cells(lnRow, 2).Value = "'" & lnCount & "-" & lnPages 
        End With 
        lnRow = lnRow + 1 
        lnCount = lnCount + 1 
    End If 
Next wsSheet 
wsActive.Activate 
wsActive.Columns("A:B").EntireColumn.AutoFit 
With Application 
    .DisplayAlerts = True 
    .ScreenUpdating = True 
End With 
End Sub

Código de ejemplo proporcionado por: Bill Jelen, MrExcel.com Este ejemplo comprueba que ya existe una hoja denominada "TOC". Si existe, el ejemplo actualiza la tabla de contenido. De lo contrario, el ejemplo crea una nueva hoja de tabla de contenido al principio del libro. El nombre de cada hoja de cálculo, junto con los números de página impresa correspondiente, aparece en la tabla de contenido. Para recuperar los números de página, el ejemplo abre el cuadro de diálogo Vista previa de impresión. Debe cerrar el cuadro de diálogo y, a continuación, se crea la tabla de contenido.

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

Acerca de los colaboradores

Dennis Wallentin es el autor de VSTO & .NET & Excel, un blog que se centra en soluciones de .NET Framework para Excel y Excel Services. Dennis lleva más de veinte años desarrollando soluciones de Excel y es, además, coautor de "Professional Excel Development: The Definitive Guide to Developing Applications Using Microsoft Excel, VBA and .NET (2nd Edition)".

Bill Jelen, MVP, es autor de más de veinticinco libros sobre Microsoft Excel. Es invitado habitual en TechTV con Leo Laporte y es el administrador de MrExcel.com, un sitio web que incluye más de 300 000 preguntas y respuestas sobre Excel.

Soporte técnico y comentarios

¿Tiene preguntas o comentarios sobre VBA para Office o esta documentación? Vea Soporte técnico y comentarios sobre VBA para Office para obtener ayuda sobre las formas en las que puede recibir soporte técnico y enviar comentarios.