24.12.2019, 22:43 (Dieser Beitrag wurde zuletzt bearbeitet: 24.12.2019, 22:43 von sharky51.)
Frohe Weihnachten zusammen,
leider lässt mich auch heute ein Problem nicht los.
Aus dem Netz habe ich einen tollen Code für ein Inhaltsverzeichnis in einer Arbeitsmappe gefunden. Der Code erzeugt ein Inhaltsverzeichnis unter Ausschluss der Tabelle für das Verzeichnis selbst.
Wie müsste der Code erweitert werden wenn ich noch eine weiteres Tabellenblatt nicht im Verzeichnis sehen möchte?
Hier der Ausschnitt für die Erstellung des Verzeichnisses:
Code:
'Create New Contents Sheet Worksheets.Add Before:=Worksheets(1)
'Set variable to Contents Sheet Set Content_sht = ActiveSheet
'Format Contents Sheet With Content_sht .Name = ContentName .Range("B1") = "Table of Contents" .Range("B1").Font.Bold = True End With
'Create Array list with sheet names (excluding Contents) ReDim myArray(1 To Worksheets.Count - 1)
For Each sht In ActiveWorkbook.Worksheets If sht.Name <> ContentName Then myArray(x + 1) = sht.Name x = x + 1 End If Next sht
'Alphabetize Sheet Names in Array List For x = LBound(myArray) To UBound(myArray) For y = x To UBound(myArray) If UCase(myArray(y)) < UCase(myArray(x)) Then shtName1 = myArray(x) shtName2 = myArray(y) myArray(x) = shtName2 myArray(y) = shtName1 End If Next y Next x
'Create Table of Contents For x = LBound(myArray) To UBound(myArray) Set sht = Worksheets(myArray(x)) sht.Activate With Content_sht .Hyperlinks.Add .Cells(x + 2, 3), "", _ SubAddress:="'" & sht.Name & "'!A1", _ TextToDisplay:=sht.Name .Cells(x + 2, 2).Value = x End With Next x
ich habe kein If - End If sondern ein Select Case verwendet. Zudem habe ich aus deinem Code die Activate rausgeschmissen, die braucht kein Mensch. Den Namen deines "Inhaltsverzeichnisses" mußt du anpassen, ich habe das Blatt "Contents" benannt.
Code:
Public Sub aaa() Dim sht As Worksheet, x As Long, y As Long Dim shtName1 As String, shtName2 As String
'Create New Contents Sheet Worksheets.Add Before:=Worksheets(1) ActiveSheet.Name = "Contents"
'Format Contents Sheet With Worksheets("Contents") .Range("B1") = "Table of Contents" .Range("B1").Font.Bold = True End With
'Create Array list with sheet names (excluding Contents) ReDim myArray(1 To Worksheets.Count - 2)
For Each sht In ThisWorkbook.Worksheets Select Case sht.Name 'Blätter die ausgeschlossen werden Case "Contents", "Konfiguration" 'nix machen Case Else myArray(x + 1) = sht.Name x = x + 1 End Select Next sht
'Alphabetize Sheet Names in Array List For x = LBound(myArray) To UBound(myArray) For y = x To UBound(myArray) If UCase(myArray(y)) < UCase(myArray(x)) Then shtName1 = myArray(x) shtName2 = myArray(y) myArray(x) = shtName2 myArray(y) = shtName1 End If Next y Next x
'Create Table of Contents For x = LBound(myArray) To UBound(myArray) Set sht = Worksheets(myArray(x)) 'sht.Activate With Worksheets("Contents") .Hyperlinks.Add .Cells(x + 2, 3), "", _ SubAddress:="'" & sht.Name & "'!A1", _ TextToDisplay:=sht.Name .Cells(x + 2, 2).Value = x End With Next x
Worksheets("Contents").Columns(3).EntireColumn.AutoFit Set sht = Nothing End Sub
ich möchte mich herzlich bei allen Beteiligten für Ihre Hilfe bedanken. Funktioniert alles Bestens, vielen Dank! Das ist einfach cool in so einem Forum immer Hilfe und Lösungen zu bekommen!
Ich wünsche Euch weiter ein frohes Weihnachtsfest!
Und zum EntireColumn, das ist dann wohl dem Pessimismus geschuldet, nach dem Motto "sicher ist sicher". Zur Sicherheit Gürtel und Hosenträger an der Hose.
26.12.2019, 12:38 (Dieser Beitrag wurde zuletzt bearbeitet: 26.12.2019, 12:38 von hddiesel.)
Hallo Erich,
hier eimal ein Beispiel, welches auch die Blattreiterfarben im Inhaltsverzeichnis übernimmt.
Die Blätter welche ausgeschlossen werden sollen, in Zahl und Text getrennt.
In jedem Arbeitsblatt, wird in A1 ein Hyperlink, "Zum Inhaltsverzeichnis" eingefügt, um wieder Direkt zum Inhaltsverzeichnis zuwechseln. Eine Beschreibung aus den einzelnen Arbeitsblättern, welche sich in der Zelle C1 befindet, wird in die Spalte B des Inhaltsverzeichnis übernommen.
Einfach einmal testen, ist jetzt nicht auf deine Arbeitsmappe angepasst, sondern ein Beispiel.
Was nicht Benötigt wird, einfach auskommentieren, oder löschen.
ich möchte mich zu dem Thema nochmals melden bzw. eine Frage stellen. Dein Vorschlag für das Ausblenden von bestimmten Blättern im Inhaltsverzeichnis mittels "Select Case" - Anweisung funktioniert ja prächtig. Ich verwende Deinen Vorschlag genau so - er ist perfekt.
Daraus hat sich für mich eine weitere Frage aufgeworfen. Wie könnte man weitere und beliebig benannte Blätter einfügen und ans Ende der Arbeitsmappe stellen. Dies sollte sich auch so im Inhaltsverzeichnis wiederspiegeln - also am Ende des Inhaltsverzeichnis sollten diese Tabellen aufgeführt werden - unabhängig ob der Tabellenname es eigentlich erfordern würde irgendwo weiter vorne im Inhaltsverzeichnis aufgeführt zu werden.
Könnte man Deinen Vorschlag dahingehend modifizieren?
