Tabellen selektiv einblenden
31.12.2005 01:12:22
Peter
Ich habe eine Tabelle mit je einem Sheet pro Tag (=366 Tabellen), mit dem Format "MMTT"
sowie vorangestellt 3 weitere Tabellen und am Schluss weitere 4 Tabellen (insgesammt 373 Tabellen).
Mein Wunsch war, dass immer die aktuelle Datei das Tages, sowie die 3 vorangestellten und die 4 Tabellen am Schluss eingeblendet sind, wenn nicht sowieso alle eingeblendet sind.
In diesem Forum hat mir jemand (finde leider den Beitrag nicht mehr) mit nachfolgendem Code geholfen (ursprünglich waren am Schluss nur 3 allgemeine Tabellen vorhanden).
Das hast wunderbar geklappt, bis ich hinten eine 4 Tabelle eingefügt habe - vielleicht hat es auch damit zu tun, dass die Tabelle "3112" auch ziemlich am Schluss erscheint.
Aufjeden Fall bewirkt nachfolgender Code heute, dass vorne - wie gewünscht 3 Tabellen angezeigt werden und hinten nur 2 (mit der Tabelle "3112" zusammen 6 Files.
Wie muss der Code verändert werden, dass auch heute die 4 letzten Tabellen angezeigt werden?
Ich war versucht, bei
Case 1 To 3, Worksheets.Count, Worksheets.Count - 2, Worksheets(aktuell).Index
Count - 2 auf Count - 4 abzuändern. Doch dann werden insgesamt nur 4 Tabellen angezeigt.
Danke fürs Feedback.
Peter
Sub ausBlenden()
Dim wks As Worksheet, aktuell As String
Application.ScreenUpdating = False
For Each wks In Worksheets
wks.Visible = True
Next wks
aktuell = Format(Month(Date), "00") & Format(Day(Date), "00")
On Error Resume Next
Sheets(aktuell).Activate
If Err.Number <> 0 Then
MsgBox " Es gibt noch kein Blatt mit dem Datum von heute ! Gesuchtes Sheet = " & aktuell, vbCritical
Exit Sub
End If
On Error GoTo 0
For Each wks In Worksheets
Select Case wks.Index
Case 1 To 3, Worksheets.Count, Worksheets.Count - 2, Worksheets(aktuell).Index
wks.Visible = xlSheetVisible
Case Else
wks.Visible = xlSheetHidden
End Select
Next wks
Application.ScreenUpdating = True
End Sub
Sub einBlenden()
Application.ScreenUpdating = False
Dim wks As Worksheet, aktuell As String
Application.ScreenUpdating = False
For Each wks In Worksheets
wks.Visible = True
Next wks
Application.ScreenUpdating = True
End Sub