24.12.2019, 21:43 (Dieser Beitrag wurde zuletzt bearbeitet: 24.12.2019, 21: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!
Mit freundlichen Grüßen / Best regards
//
----------o00o---°(_)°---o00o----------------------
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, 11:38 (Dieser Beitrag wurde zuletzt bearbeitet: 26.12.2019, 11: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?
Freue mich auf einen Lösungsweg!
Mit freundlichen Grüßen / Best regards
//
----------o00o---°(_)°---o00o----------------------
