Hinzufügen eines Inhaltsverzeichnisses zu einer Arbeitsmappe
Im folgenden Beispiel werden unterschiedliche Ansätze für das Hinzufügen eines Inhaltsverzeichnisses zu einer Excel-Arbeitsmappe veranschaulicht.
Beispielcode bereitgestellt von:Dennis Wallentin, VSTO & .NET & Excel
In diesem Beispiel wird die Pages.Count-Eigenschaft (Excel) verwendet, um die Anzahl der Seiten auf jedem Blatt zu berechnen. Außerdem werden die Einträge im Inhaltsverzeichnis mit den entsprechenden Blättern verknüpft, um die Arbeitsmappennavigation auf dem Bildschirm zu verbessern.
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
Beispielcode bereitgestellt von: Bill Jelen, MrExcel.com In diesem Beispiel wird überprüft, ob bereits ein Blatt mit dem Namen "TOC" vorhanden ist. Wenn es vorhanden ist, wird das Inhaltsverzeichnis aktualisiert. Andernfalls erstellt das Beispiel ein neues Inhaltsverzeichnis am Anfang der Arbeitsmappe. Der Name jedes Arbeitsblatts wird zusammen mit den entsprechenden gedruckten Seitenzahlen im Inhaltsverzeichnis aufgeführt. Zum Abrufen der Seitenzahlen wird im Beispiel das Dialogfeld "Seitenansicht" geöffent. Sie müssen das Dialogfeld schließen, daraufhin wird das Inhaltsverzeichnis erstellt.
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
Informationen zu den Mitwirkenden
Dennis Wallentin ist Autor des Blogs VSTO & .NET & Excel, dessen Schwerpunkt auf .NET Framework-Lösungen für Excel und Excel Services liegt. Dennis entwickelt Excel-Lösungen seit über 20 Jahren und ist Co-Autor von "Professional Excel Development: The Definitive Guide to Developing Applications Using Microsoft Excel, VBA and .NET (2nd Edition)."
MVP Bill Jelen hat über zwei Dutzend Bücher über Microsoft Excel verfasst. Er ist regelmäßiger Gast auf TechTV mit Leo Laporte und hostet MrExcel.com, ein Forum mit über 300.000 Fragen und Antworten zu Excel.
Support und Feedback
Haben Sie Fragen oder Feedback zu Office VBA oder zu dieser Dokumentation? Unter Office VBA-Support und Feedback finden Sie Hilfestellung zu den Möglichkeiten, wie Sie Support erhalten und Feedback abgeben können.
Feedback
https://aka.ms/ContentUserFeedback.
Bald verfügbar: Im Laufe des Jahres 2024 werden wir GitHub-Issues stufenweise als Feedbackmechanismus für Inhalte abbauen und durch ein neues Feedbacksystem ersetzen. Weitere Informationen finden Sie unterFeedback senden und anzeigen für