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
Content_sht.Activate
Content_sht.Columns(3).EntireColumn.AutoFit
Wäre toll wenn mir jemand einen Tipp gegen könnte.
Ach ja, das Blatt das auch nicht im Verzeichnis zu sehen sein sollte nennt sich "Konfiguration"
Hallo,
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
Gruß Werner
(25.12.2019, 09:28)Werner.M schrieb: [ -> ]Zudem habe ich aus deinem Code die Activate rausgeschmissen, die braucht kein Mensch.
Moin Werner!
Wie wahr!
Allerdings braucht auch niemand ein ActiveSheet, aber das nur am Rande …
With Worksheets.Add(Sheets(1))
.Name = "Contents"
With .Range("B1")
.Font.Bold = True
.Value = "Table of contents"
End With
End With
Und wenn ich eine Spalte per .Columns(3) anspreche, ist .EntireColumn doppelt gemoppelt:
.Columns(3).AutoFit
Gruß Ralf
Hallo zusammen,
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!
Hallo Ralf,
Zitat:Allerdings braucht auch niemand ein ActiveSheet, aber das nur am Rande …
mit dieser Aussage habe ich mal irgendwo in einem Forum einen kleinen Shitstorm ausgelöst.
Hallo Ralf,
da gebe ich dir vollumfänglich recht.
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.
Gruß Werner
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.
Hallo Karl,
super Beispiel, vielen Dank, kann ich sicher weiterverwenden.
Wünsche noch einen schönen 2. Weihnachtsfeiertag!
Hallo Werner,
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!