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.
Comentários
https://aka.ms/ContentUserFeedback.
Em breve: Ao longo de 2024, eliminaremos os problemas do GitHub como o mecanismo de comentários para conteúdo e o substituiremos por um novo sistema de comentários. Para obter mais informações, consulteEnviar e exibir comentários de