Adicionar um sumário a uma pasta de trabalho

Os exemplos a seguir mostram diferentes abordagens para adicionar um sumário a uma pasta de trabalho do Excel.

Código de exemplo fornecido por: Dennis Wallentin, VSTO & .NET & Excel

Este exemplo usa a propriedade Pages.Count (Excel) para calcular o número de páginas em cada planilha. Além disso, as entradas do Sumário estão vinculadas a suas respectivas planilhas para melhorar a navegação da pasta de trabalho na tela.

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 exemplo fornecido por: Bill Jelen, MrExcel.com Este exemplo verifica se uma planilha chamada "TOC" já existe. Se existir, o exemplo atualiza o sumário. Caso contrário, o exemplo cria uma nova planilha Sumário no início da pasta de trabalho. O nome de cada planilha, junto com os números de página impressa correspondente, está listado na tabela de conteúdo. Para recuperar os números de página do exemplo abre a caixa de diálogo Visualização de Impressão. Você deve fechar a caixa de diálogo para que o sumário seja criado.

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

Sobre os colaboradores

Dennis Wallentin é o autor do VSTO & .NET & Excel, um blog que se concentra em soluções .NET Framework para Excel e Serviços do Excel. Dennis vem desenvolvendo soluções Excel há mais de 20 anos e também é coautor de "Desenvolvimento do Excel Profissional: O Guia Definitivo para o Desenvolvimento de Aplicativos Usando o Microsoft Excel, VBA e .NET (2ª Edição)".

MVP Bill Jelen é autor de mais de duas dúzias de livros sobre o Microsoft Excel. Ele é um convidado regular na TechTV com Leo Laporte, e é o anfitrião do MrExcel.com, que inclui mais de 300.000 perguntas e respostas sobre o Excel.

Suporte e comentários

Tem dúvidas ou quer enviar comentários sobre o VBA para Office ou sobre esta documentação? Confira Suporte e comentários sobre o VBA para Office a fim de obter orientação sobre as maneiras pelas quais você pode receber suporte e fornecer comentários.