Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1816to1820
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
Inhaltsverzeichnis

Verzeichnis nur sichtbare Sheets

Verzeichnis nur sichtbare Sheets
11.03.2021 13:02:07
Eisi
Hallo zusammen,
nachfolgender Code funktioniert super. Mir fehlt nur noch die Einstellung, dass ausgeblendete Blätter im Inhaltsverzeichnis nicht aufgeführt werden. Mit diesem Code wird alles eingeblendet, egal ob sichtbar, oder auch nicht.
Vielen Dank vorab für die Hilfe.
VG Eisi :-)
Sub TabellenVerzeichnisErstellenPlusHyperlinks()
tbl_Start.Unprotect ("")                      'Blattschutz öffnen, damit der Code  _
durchlaufen kann
Dim intTab As Integer
Dim tbl    As Worksheet
Dim intZeile As Integer
On Error GoTo TabellenVerzeichnisErstellenPlusHyperlinks_Error
Set tbl = tbl_Start
tbl.UsedRange.Clear
intZeile = 3                                  ' Fängt in Zeile 3 an
With tbl_Start.Range("B1")                    ' Schreibt in die Zelle B1 eine Überschrift  _
rein
.Value = "Test"
.Font.Bold = True
.Font.Size = 24
End With
With ActiveSheet
.Cells.Interior.ColorIndex = xlNone
.Cells.Interior.ColorIndex = 2            'Hintergrundfarbe weiß
End With
With ActiveWindow                             ' Hiermit wird die Ansicht eingefroren,
.SplitColumn = 30                         ' damit der Bildschirm nicht mehr gescrollt  _
werden kann
.SplitRow = 33
.FreezePanes = True
End With
For intTab = 1 To ActiveWorkbook.Worksheets.Count ' 1 Zählt ab dem ersten Sheet
tbl.Cells(intZeile, 2).Value = Worksheets(intTab).Name
tbl.Cells(intZeile, 2).Hyperlinks.Add _
Anchor:=tbl.Cells(intZeile, 2), Address:="", SubAddress:= _
"'" & Worksheets(intTab).Name & "'!A1", _
ScreenTip:="Klicken Sie auf den Hyperlink", _
TextToDisplay:=Worksheets(intTab).Name
intZeile = intZeile + 1
Next intTab
On Error GoTo 0
Range("B3").Select                            'In dieser Zelle steht der Cusor
Range("B3:B30").Locked = False                'Diese Zellen sind nicht geschützt und somit  _
funktionieren die Hyperlinks
tbl_Start.Protect ("")                        'Die Tabelle wieder sperren, damit der User  _
hier nicht verstellen kann
Exit Sub
TabellenVerzeichnisErstellenPlusHyperlinks_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure TabellenVerzeichnisErstellenPlusHyperlinks of Modul mdl_Verarbeitung in  _
Zeile " & Erl
End Sub


10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:23:11
Werner
Hallo,
da brauchst du doch nur innerhalb der Schleife über die Tabellenblätter eine Prüfung einzubauen, ob das jeweilige Blatt eingeblendet ist oder nicht.
For intTab = 1 To ActiveWorkbook.Worksheets.Count
If Worksheets(intTab).Visible = True Then
tbl.Cells(intZeile, 2).Value = Worksheets(intTab).Name
tbl.Cells(intZeile, 2).Hyperlinks.Add _
Anchor:=tbl.Cells(intZeile, 2), Address:="", SubAddress:= _
"'" & Worksheets(intTab).Name & "'!A1", _
ScreenTip:="Klicken Sie auf den Hyperlink", _
TextToDisplay:=Worksheets(intTab).Name
intZeile = intZeile + 1
End If
Next intTab
Gruß Werner

Anzeige
AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:36:25
Eisi
Herzlichen Dank Werner, jetzt funktioniert es wie gewünscht.
GLG Eisi :-)

Gerne u. Danke für die Rückmeldung. o.w.T.
11.03.2021 13:38:09
Werner

AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:26:20
Nepumuk
Hallo,
einfach abfragen ob die Tabelle sichtbar ist:
Option Explicit

Sub TabellenVerzeichnisErstellenPlusHyperlinks()
    
    tbl_Start.Unprotect ("") 'Blattschutz öffnen, damit der Code durchlaufen kann
    
    Dim intTab As Integer
    Dim tbl As Worksheet
    Dim intZeile As Integer
    
    
    On Error GoTo TabellenVerzeichnisErstellenPlusHyperlinks_Error
    
    Set tbl = tbl_Start
    tbl.UsedRange.Clear
    intZeile = 3 ' Fängt in Zeile 3 an
    
    
    With tbl_Start.Range("B1") ' Schreibt in die Zelle B1 eine Überschrift rein
        .Value = "Test"
        .Font.Bold = True
        .Font.Size = 24
    End With
    
    
    With ActiveSheet
        .Cells.Interior.ColorIndex = xlNone
        .Cells.Interior.ColorIndex = 2 'Hintergrundfarbe weiß
    End With
    
    
    With ActiveWindow ' Hiermit wird die Ansicht eingefroren,
        .SplitColumn = 30 ' damit der Bildschirm nicht mehr gescrollt werden kann
        .SplitRow = 33
        .FreezePanes = True
    End With
    
    
    For intTab = 1 To ThisWorkbook.Worksheets.Count ' 1 Zählt ab dem ersten Sheet
        
        If Worksheets(intTab).Visible = xlSheetVisible Then
            
            tbl.Cells(intZeile, 2).Value = Worksheets(intTab).Name
            
            tbl.Cells(intZeile, 2).Hyperlinks.Add _
                Anchor:=tbl.Cells(intZeile, 2), Address:="", SubAddress:= _
                "'" & Worksheets(intTab).Name & "'!A1", _
                ScreenTip:="Klicken Sie auf den Hyperlink", _
                TextToDisplay:=Worksheets(intTab).Name
            
            intZeile = intZeile + 1
            
        End If
    Next intTab
    
    On Error GoTo 0
    
    Range("B3").Select 'In dieser Zelle steht der Cusor
    
    Range("B3:B30").Locked = False 'Diese Zellen sind nicht geschützt und somit _
        funktionieren die Hyperlinks

    
    
    tbl_Start.Protect ("") 'Die Tabelle wieder sperren, damit der User _
        hier nicht verstellen kann

    
    Exit Sub
    
    TabellenVerzeichnisErstellenPlusHyperlinks_Error:
    
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure " & _
        "TabellenVerzeichnisErstellenPlusHyperlinks of Modul mdl_Verarbeitung in Zeile " & Erl
    
End Sub

Gruß
Nepumuk

Anzeige
AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:39:42
Eisi
Herzlichen Dank Nepumuk, der Code läuft jetzt super.
GLG Eisi :-)

AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:28:14
Nepumuk
Hallo,
einfach abfragen ob die Tabelle sichtbar ist:
Option Explicit

Sub TabellenVerzeichnisErstellenPlusHyperlinks()
    
    tbl_Start.Unprotect ("") 'Blattschutz öffnen, damit der Code durchlaufen kann
    
    Dim intTab As Integer
    Dim tbl As Worksheet
    Dim intZeile As Integer
    
    
    On Error GoTo TabellenVerzeichnisErstellenPlusHyperlinks_Error
    
    Set tbl = tbl_Start
    tbl.UsedRange.Clear
    intZeile = 3 ' Fängt in Zeile 3 an
    
    
    With tbl_Start.Range("B1") ' Schreibt in die Zelle B1 eine Überschrift rein
        .Value = "Test"
        .Font.Bold = True
        .Font.Size = 24
    End With
    
    
    With ActiveSheet
        .Cells.Interior.ColorIndex = xlNone
        .Cells.Interior.ColorIndex = 2 'Hintergrundfarbe weiß
    End With
    
    
    With ActiveWindow ' Hiermit wird die Ansicht eingefroren,
        .SplitColumn = 30 ' damit der Bildschirm nicht mehr gescrollt werden kann
        .SplitRow = 33
        .FreezePanes = True
    End With
    
    
    For intTab = 1 To ThisWorkbook.Worksheets.Count ' 1 Zählt ab dem ersten Sheet
        
        If Worksheets(intTab).Visible = xlSheetVisible Then
            
            tbl.Cells(intZeile, 2).Value = Worksheets(intTab).Name
            
            tbl.Cells(intZeile, 2).Hyperlinks.Add _
                Anchor:=tbl.Cells(intZeile, 2), Address:="", SubAddress:= _
                "'" & Worksheets(intTab).Name & "'!A1", _
                ScreenTip:="Klicken Sie auf den Hyperlink", _
                TextToDisplay:=Worksheets(intTab).Name
            
            intZeile = intZeile + 1
            
        End If
    Next intTab
    
    On Error GoTo 0
    
    Range("B3").Select 'In dieser Zelle steht der Cusor
    
    Range("B3:B30").Locked = False 'Diese Zellen sind nicht geschützt und somit _
        funktionieren die Hyperlinks

    
    
    tbl_Start.Protect ("") 'Die Tabelle wieder sperren, damit der User _
        hier nicht verstellen kann

    
    Exit Sub
    
    TabellenVerzeichnisErstellenPlusHyperlinks_Error:
    
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure " & _
        "TabellenVerzeichnisErstellenPlusHyperlinks of Modul mdl_Verarbeitung in Zeile " & Erl
    
End Sub

Gruß
Nepumuk

Anzeige
AW: Verzeichnis nur sichtbare Sheets
11.03.2021 13:45:14
ChrisL
Hi
Mal ein wenig aufgeräumt z.B. konsequente Referenzierung (nicht einmal tbl_Start, dann tbl und dann wieder ActiveSheet).
Sub TabellenVerzeichnisErstellenPlusHyperlinks()
Dim wks As Worksheet
Dim intZeile As Integer
On Error GoTo TabellenVerzeichnisErstellenPlusHyperlinks_Error
With tbl_Start
.Unprotect ("")                      'Blattschutz öffnen, damit der Code durchlaufen kann
.UsedRange.Clear
.Activate
With ActiveWindow                    ' Hiermit wird die Ansicht eingefroren,
.SplitColumn = 30                ' damit der Bildschirm nicht mehr gescrollt werden  _
kann
.SplitRow = 33
.FreezePanes = True
End With
With .Range("B1")                    ' Schreibt in die Zelle B1 eine Überschrift rein
.Value = "Test"
.Font.Bold = True
.Font.Size = 24
End With
.Cells.Interior.ColorIndex = xlNone
.Cells.Interior.ColorIndex = 2        'Hintergrundfarbe weiß
.Range("B3:B30").Locked = False       'Diese Zellen sind nicht geschützt und somit  _
funktionieren die Hyperlinks
intZeile = 3                          ' Fängt in Zeile 3 an
For Each wks In ThisWorkbook.Worksheets
If wks.Visible Then
.Cells(intZeile, 2).Value = wks.Name
.Cells(intZeile, 2).Hyperlinks.Add _
Anchor:=.Cells(intZeile, 2), Address:="", SubAddress:="'" & wks.Name & "'!A1", _
ScreenTip:="Klicken Sie auf den Hyperlink", TextToDisplay:=wks.Name
intZeile = intZeile + 1
End If
Next wks
.Protect ("")                         'Die Tabelle wieder sperren, damit der User hier  _
nicht verstellen kann
.Range("B3").Select                   'In dieser Zelle steht der Cusor
End With
Exit Sub
TabellenVerzeichnisErstellenPlusHyperlinks_Error:
tbl_Start.Protect ("")
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure  _
TabellenVerzeichnisErstellenPlusHyperlinks of Modul mdl_Verarbeitung in Zeile " & Erl
End Sub

cu
Chris

Anzeige
AW: Verzeichnis nur sichtbare Sheets
11.03.2021 14:58:18
Eisi
Hallo Chris,
danke für den Hinweis, so lerne ich dazu. Habe mir den Code erst mal genauer anschauen müssen, um den optimalen Weg zu verstehen.
Den letzten Code bezügl. protect habe ich nach oben geschoben, sonst ist das Blatt nicht gesperrt.
Vielen herzlichen Dank.
GlG Eisi :-)

AW: Verzeichnis nur sichtbare Sheets
11.03.2021 15:04:57
ChrisL
hi
Protect ist doppelt. Wenn du auf einen unvorhergesehenen Fehler läufst, dann möchtest du die Tabelle vielleicht trotzdem wieder schützen.
cu
Chris

AW: Verzeichnis nur sichtbare Sheets
11.03.2021 15:27:32
Eisi
Ah, deshalb, habe ich wieder angepasst. Danke :-)

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige