Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
736to740
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
736to740
736to740
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Inhaltsverzeichnis

Inhaltsverzeichnis
22.02.2006 15:25:05
Daniele
Hallo!
Ich suche ein Makro welches mir ein Inhaltsverzeichnis von allen Arbeitsblättern in einer Arbeitsmappe erstellt. Es sollte dann eine Verlinkung [Hyperlink) vorhanden sein.
Ich könnte mir vorstellen dass so ein Makro existiert, habe im Netz aber keines gefunden....
Hat jemand villeicht eine Idee?
Ich würde mich freuen, vielen Dank,
Daniele

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Inhaltsverzeichnis
22.02.2006 15:45:00
Peter
Servus,
allzu Intensiv kann deine Suche nicht gewesen sein, hab das Makro glaube ich schon 5x gepostet.


Option Explicit
'**************************************************
'*              Peter W / Sept. 05                *
'**************************************************
Sub Inhaltsverzeichnis()
Dim lngAnf As Long, lngSpalte As Long
Dim intZ As Integer
Dim wks As Worksheet
Dim bolVis As Boolean, bolHyp As Boolean, bolWks As Boolean
Dim rng As Range
Dim strWks As String, strTarget As String
'**********Ablaufkriterien festlegen***************
bolWks = False
On Error Resume Next
Set rng = Application.InputBox("Startzelle des Inhaltsverzeichnises ?", "Startrange", "A1", Type:=8)
If Not rng Is Nothing Then
    lngAnf = rng.Row - 1 'Start ab Zeile x (z.B. A1 = 1-1 = 0 , Start Zeile 1)
    lngSpalte = rng.Column  'In Spalte x (z.B. 1 = A)
Else: Exit Sub
End If
bolVis = Application.InputBox("Nur sichtbare Blätter aufführen ?", "WAHR oder Abbrechen", Type:=4) 'Nur eingeblendete Sheets = True
bolHyp = Application.InputBox("Hyperlinks erstellen ?", "WAHR oder Abbrechen", Type:=4) 'Hyperlink erzeugen = True , sonst False
strWks = Application.InputBox("In welchem Tabellenblatt soll das Inhaltsverzeichnis geschrieben werden ?" _
        , "Tabellenblatt", ActiveSheet.name, Type:=2)
If strWks = "" Then Exit Sub
    For Each wks In ThisWorkbook.Worksheets
        If wks.name = strWks Then bolWks = True
    Next
    If bolWks = False Then Exit Sub
If bolHyp Then
    Set rng = Nothing
    Set rng = Application.InputBox("An welchen Punkt soll der Hyperlink springen ?", "Hyperlink 2", "A1", Type:=8)
    If Not rng Is Nothing Then
        strTarget = "!" & rng.Address(0, 0)
    Else: Exit Sub
    End If
End If
'**************************************************
With Sheets(strWks)
    For Each wks In ThisWorkbook.Worksheets
        intZ = intZ + 1
        If bolVis Then
            If wks.Visible = xlSheetVisible Then
                If bolHyp Then
                    If Not .Cells(lngAnf + intZ, lngSpalte).Hyperlinks Is Nothing Then
                        .Hyperlinks.Add anchor:=.Cells(lngAnf + intZ, lngSpalte) _
                        , Address:="", SubAddress:=wks.name & strTarget, TextToDisplay:=wks.name & " Pos.: " & intZ
                    Else
                        .Cells(lngAnf + intZ, lngSpalte).Hyperlinks(1) _
                        .SubAddress = wks.name & strTarget
                        .Cells(lngAnf + intZ, lngSpalte).Hyperlinks(1) _
                        .TextToDisplay = wks.name & " Pos.: " & intZ
                    End If
                Else
                ActiveSheet.Cells(lngAnf + intZ, lngSpalte) = wks.name & " Pos.: " & intZ
                End If
            End If
        Else
            If bolHyp Then
                If Not .Cells(lngAnf + intZ, lngSpalte).Hyperlinks Is Nothing Then
                    .Hyperlinks.Add anchor:=.Cells(lngAnf + intZ, lngSpalte) _
                    , Address:="", SubAddress:=wks.name & strTarget, TextToDisplay:=wks.name & " Pos.: " & intZ
                Else
                    .Cells(lngAnf + intZ, lngSpalte).Hyperlinks(1) _
                    .SubAddress = wks.name & strTarget
                    .Cells(lngAnf + intZ, lngSpalte).Hyperlinks(1) _
                    .TextToDisplay = wks.name & " Pos.: " & intZ
                End If
            Else
                ActiveSheet.Cells(lngAnf + intZ, lngSpalte) = wks.name & " Pos.: " & intZ
            End If
        End If
    Next
End With
End Sub


MfG Peter
Anzeige
AW: Inhaltsverzeichnis
22.02.2006 15:51:03
Daniele
Oh...habe die 2te Antwort gar nicht gesehen...
naja ich habe schon eine Weile gesucht....da die suchworte allerdings sehr häufig benutzt werden ist es nicht einfach auf das zu stoßen was man in diesem Fall sucht,
seis drum! Allzu lange habe ich dann doch nicht gesucht ; )
VIELEN DANK!!!!!!!!
AW: Inhaltsverzeichnis
22.02.2006 15:47:25
Daniele
Vielen Dank für die schnelle Antwort!
Diese Lösung ist sicherlich nicht schlecht, finde aber eine einfache Variante besser, da sie weniger Platz benötigt...
würde mich freuen wenn noch jemand eine Lösung anzubieten hat.
Grüße
Daniele,

Links zu Excel-Dialogen

InputBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige