VBA Code Schnipsel: Inhaltsverzeichnis für Arbeitsmappen erstellen

Vor kurzem hatte ich es wieder einmal mit einer Arbeitsmappe zu tun mit vielen Arbeitsblätter.

«Eine Übersicht mit allen Tabellenblätter-Namen wäre nützlich!», dachte ich mir.

Wie immer gibt es bei Excel mehrere Wege die nach Rom führen, aber eine vernünftiges Inhaltsverzeichnis schien mir im gegebenen Fall die beste Lösung um einen Überblick zu bekommen!

Also erstellte ich mir eines mit VBA…

Inhaltsverzeichnis mit VBA erstellen

Und heute teile ich diesen Code mit Euch, damit Ihr ihn auch für Euch einsetzen könnt!

Der folgende Code Schnipsel muss einfach in ein neues Modul einfügt werden im VBE (Visual Basic Editor). Hier zuerst als Screenshot im kompakt Format…

Und jetzt dazu wie Ihr es bei Euch implementieren könnt…

Den VBE könnt Ihr mit der Tastenkombination ALT+F11 aufrufen.

Danach Einfügen>Modul auswählen… und den gesamten unterstehenden Code in das neue Modul reinkopieren.

Option Explicit

' ----------------------------------------------------------------
' Procedure Name: AddDirectory
' Purpose: Fügt ein Inhaltsverzeichnis mit Hyperlinks in die Arbeitsmappe ein (als erstes Arbeitsblatt)
' Procedure Kind: Sub
' Procedure Access: Public
' Author: ExcelNova.org | Lukas Rohr
' Date: 28.06.2019
' ----------------------------------------------------------------

Sub AddDirectory()
Dim wksDest As Worksheet
Dim w As Worksheet
Dim i As Long

Application.DisplayAlerts = False

With ActiveWorkbook
If SheetExists("Inhalt") Then
.Worksheets("Inhalt").Delete
End If
Set wksDest = .Worksheets.Add(Before:=.Worksheets(1))
wksDest.Name = "Inhalt"
End With

With wksDest.Range("B2")
.Value = "Übersicht"
.Font.Bold = True
.Font.Size = 24
For i = 2 To ThisWorkbook.Worksheets.Count
wksDest.Hyperlinks.Add Anchor:=.Offset(i, 0), Address:="", SubAddress:= _
"'" & ThisWorkbook.Worksheets(i).Name & "'!A1", TextToDisplay:=ThisWorkbook.Worksheets(i).Name
Next i
End With
Application.DisplayAlerts = True
End Sub

Function SheetExists(SName As String, _
Optional ByVal wb As Workbook) As Boolean
On Error Resume Next
If wb Is Nothing Then Set wb = ThisWorkbook
SheetExists = CBool(Len(wb.Sheets(SName).Name))
End Function

Zuletzt müsst Ihr nur noch F5 drücken!

So wird das ganze ausgeführt… die Datei enthält danach automatisch ein Inhaltsverzeichnis mit jedem Arbeitsblattnamen als Hyperlink!

Wenn Euch Code Schnipsel gefallen, lasst es mich in den Kommentaren wissen!