Hyperlinks auf Tabellenblattnamen
21.07.2015 20:03:57
MB12
aus einem Planungstool wird wöchentlich eine Excel-Auswertung erstellt. Diese Datei umfasst
1. ca 15 Blätter für die wichtigsten Phasen der Produktion von Maschinen. Blattnamen z.B. Konstruktion, Montage. In Spalte A steht jeweils die Bezeichnung der Maschinen, die sich gerade in dieser Phase befinden (Projektnummer-Maschinennummer). Alle rot markierten Maschinen (Terminverzug) müssen detailliert besprochen werden, und zwar unter Verwendung von
2. ca 200 Blättern mit der Einzelauswertung des Produktionsstands jeder Maschine. Blattnamen sind immer eindeutig (ebenfalls Projektnummer-Maschinennummer). Die Sortierung der Blätter lässt sich leider nicht verwenden.
3. davor und danach weitere Tabellenblätter mit sonstigen Auswertungen und Zusammenfassungen.
Wie oben erwähnt, werden in einer Besprechung die Phasen (siehe 1.) nacheinander besprochen, und zwar immer unter Zuhilfenahme der Einzelauswertungen (siehe 2.).
Ich habe zwar einen Code (siehe unten) im Web gefunden und in einer anderen Datei erfolgreich getestet, durch den ein weiteres Blatt "Inhaltsverzeichnis" generiert wird mit den Namen aller Tabellenblätter als Hyperlink zu sämtlichen Blättern, aber wegen der Menge der Blätter müssten sich die Beteiligten wieder durch eine lange Liste mit 12-stelligen Nummern kämpfen.
Eine große Erleichterung wäre ein Code, durch das von jedem Phasenblatt (1) die Maschinenbezeichnungen in Spalte A zu Hyperlinks zu den darin aufgelisteten Einzelblättern (2) umgewandelt werden. Eine zusätzliche "zurück"-Möglichkeit z.B. mit Strg+irgendwas wäre natürlich der Gipfel.
Eine kleine Musterdatei habe ich beigefügt.
https://www.herber.de/bbs/user/98987.xlsx
Hier der Code "Inhaltsverzeichnis" sorry, sieht nicht sauber aus (das mit dem ScreenTip:="Klicken Sie um zur Tabelle zu gelangen" scheint bei mir nicht zu funktionieren, da müsste ich vermutlich noch irgend etwas eintragen ?)
Sub Inhaltsverzeichnis()
Dim intTab As Integer
Dim tbl As Worksheet
Dim intZeile As Integer
Set tbl = Worksheets.Add(before:=Worksheets(1))
intZeile = 2
' Zellenüberschriften
ActiveSheet.Name = Worksheets(1).Name
Cells(1, 1).Value = "Überschrift"
Cells(1, 2).Value = "Link"
Cells(1, 1).Font.Bold = True
Cells(1, 2).Font.Bold = True
' eingefügtes Blatt "Inhaltsverzeichnis" nennen
Worksheets(1).Name = "Inhaltsverzeichnis"
ActiveSheet.Name = Worksheets(1).Name
Cells(1, 1).Value = "Enthaltene Blätter"
For intTab = 2 To ActiveWorkbook.Worksheets.Count
tbl.Cells(intZeile, 1).Value = Worksheets(intTab).Name
'Übernahme der Registerblattfarbe als Schriftfarbe
tbl.Cells(intZeile, 1).Font.Color = Worksheets(intTab).Tab.Color
'Setzen eines Hyperlinks auf Tabellenblatt
tbl.Cells(intZeile, 1).Hyperlinks.Add _
Anchor:=tbl.Cells(intZeile, 1), Address:="", SubAddress:= _
"'" & Worksheets(intTab).Name & "'!A1", _
ScreenTip:="Klicken Sie um zur Tabelle zu gelangen", _
TextToDisplay:=Worksheets(intTab).Name
intZeile = intZeile + 1
Next intTab
' Spaltenbreite fixieren
Worksheets(1).Cells.EntireColumn.AutoFit
End Sub
Vielen Dank schon jetzt!