Inhaltsverzeichnis mit Daten aus Tabellenblättern
08.03.2006 11:55:15
hanno
ich habe folgendes Problem:
Ich habe derzeit ein Makro, dass automatisch ein Inhaltsverzeichnis mit Hyperlinks erstellt und zusätzlich noch Alphabetisch sortiert.
Nun möchte ich folgendes: Hinter jedem Link zu dem entsprechenden Tabellenblatt soll zusätzlich noch ein Wert aus einem bestimmten Feld des entsprechenden Tabellenblattes stehen.
Das soll aussehen wie in folgendem Beispiel dargestellt
Wie kann ich das (was in Spalte E dargestellt ist) in das Markro einbinden?
Gruß
Hanno
p.s.
Den Code für das Inhaltsverzeichnis habe ich im Internet gefunden und stelle den für andere Interessierte mal mit in den Beitrag.
Option Explicit
'Name des Verzeichnisblattes
Const c_Name_Verzeichnisblatt = "Verzeichnis"
'Konstanten des Verzeichnisses
Const c_Text_Font = "Arial"
Const c_Header_Zeile = 2
Const c_Header_Spalte = 2
Const c_Header_Text = "Inhaltsverzeichnis"
Const c_Header_Fontsize = 14
Const c_Tab_Zeile1 = c_Header_Zeile + 2
Const c_Tab_Spalte_BlattNr = c_Header_Spalte
Const c_Tab_Spalte_BlattName = c_Header_Spalte + 1
Const c_Tab_Spalte_BlattNr_Text = "Nr."
Const c_Tab_Spalte_BlattName_Text = "Blatt"
Const c_Tab_Fontsize = 11
Sub BlattVerzeichnis_als_erstes_Blatt_fuehren()
' BlattVerzeichnis_als_erstes_Blatt_fuehren
' sorgt dafür, dass als erstes Blatt ein Verzeichnisblatt geführt wird
' auf dem alle Blätter der Arbeitsmappe alphabethisch aufgelistet sind
' die Blätter in der Arbeitsmappe entsprechend sortiert
' wenn ein Verzeichnis bereits existiert -> löschen
Application.ScreenUpdating = False 'Bildschirmupdate abschalten
Call VorhandenesBlattVerweis_loeschen
Call Verweisblatt_einfuegen
Call Verzeichnis_auf_Verzeichnisblatt_erstellen
Call Verzeichnis_auf_Verzeichnisblatt_sortieren
Call Verzeichnis_auf_Verzeichnisblatt_Hyperlinks_einfügen
ThisWorkbook.Worksheets(1).Select
Application.ScreenUpdating = True 'Bildschirmupdate einschalten
End Sub
Private Sub VorhandenesBlattVerweis_loeschen()
'löscht ggf. das vohandene Verzeichnisblatt
On Error Resume Next
Application.DisplayAlerts = False 'dumme Nachfragen abschalten
ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt).Delete
Application.DisplayAlerts = True
End Sub
Private Sub Verweisblatt_einfuegen()
ThisWorkbook.Worksheets.Add Before:=ThisWorkbook.Worksheets(1)
ThisWorkbook.Worksheets(1).Name = c_Name_Verzeichnisblatt
End Sub
Private Sub Verzeichnis_auf_Verzeichnisblatt_sortieren()
ThisWorkbook.Worksheets(1).Range(Cells(c_Tab_Zeile1 + 2, c_Tab_Spalte_BlattName), _
Cells(c_Tab_Zeile1 + ThisWorkbook.Worksheets.Count, c_Tab_Spalte_BlattName)).Sort _
Key1:=ThisWorkbook.Worksheets(1).Columns(c_Tab_Spalte_BlattName), _
Order1:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End Sub
Private Sub Verzeichnis_auf_Verzeichnisblatt_Hyperlinks_einfügen()
Dim ws As Worksheet
Dim i As Integer
Set ws = ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt)
ws.Activate
For i = 2 To (ThisWorkbook.Worksheets.Count)
ws.Hyperlinks.Add _
Anchor:=Range(ws.Cells(c_Tab_Zeile1 + i, c_Tab_Spalte_BlattName), _
ws.Cells(c_Tab_Zeile1 + i, c_Tab_Spalte_BlattName)), _
Address:="", _
SubAddress:=ws.Cells(c_Tab_Zeile1 + i, c_Tab_Spalte_BlattName).Value & "!A1"
Next i
End Sub
Private Sub Verzeichnis_auf_Verzeichnisblatt_erstellen()
Dim ws As Worksheet
Dim i As Long, l_zeile As Long, l_wsAnz As Long
'Tabellenblatt "Verzeichnis"
Set ws = ThisWorkbook.Worksheets(c_Name_Verzeichnisblatt)
'Tabelle der Blätter aufbauen
l_zeile = c_Tab_Zeile1
'Überschriften
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Value = c_Tab_Spalte_BlattNr_Text
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Font.Bold = True 'Fett
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Value = c_Tab_Spalte_BlattName_Text
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Font.Bold = True 'Fett
'Tabelle mit Nr/Tabellenname füllen
l_wsAnz = ThisWorkbook.Worksheets.Count 'Anzahl Tabellenblaetter
For i = 1 To l_wsAnz
l_zeile = l_zeile + 1
ws.Cells(l_zeile, c_Tab_Spalte_BlattNr).Value = i
ws.Cells(l_zeile, c_Tab_Spalte_BlattName).Value = ThisWorkbook.Worksheets(i).Name
Next i
'Tabelle formatieren
'Schriftart und -groesse,Asurichtung der Spalte 1
ws.Range(Cells(c_Tab_Zeile1, c_Tab_Spalte_BlattNr), _
Cells(c_Tab_Zeile1 + l_wsAnz, c_Tab_Spalte_BlattNr)).Select
With Selection
.Font.Name = c_Text_Font
.Font.Size = c_Tab_Fontsize
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
'Schriftart und -groesse,Asurichtung der Spalte 2
ws.Range(Cells(c_Tab_Zeile1, c_Tab_Spalte_BlattName), _
Cells(c_Tab_Zeile1 + l_wsAnz, c_Tab_Spalte_BlattName)).Select
With Selection
.Font.Name = c_Text_Font
.Font.Size = c_Tab_Fontsize
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
End With
'Spaltenbreite anpassen
ws.Columns(c_Tab_Spalte_BlattNr).AutoFit
ws.Columns(c_Tab_Spalte_BlattName).AutoFit
'Hauptueberschrift
With ws.Cells(c_Header_Zeile, c_Header_Spalte)
.Value = c_Header_Text
.Font.Bold = True 'Fett
.Font.Name = c_Text_Font
.Font.Size = c_Header_Fontsize
End With
End Sub