Sub AnzeigeTB_Blatt(DatumBis As Date)
Dim Anz As Long
Dim DatumTBl As Date
Dim DatumAb As Date
Dim Sh As Worksheet
Dim Anzeigen As Long
Anz = Range("AnzTage").Value
DatumAb = DatumBis - Anz
For Each Sh In Me.Worksheets
If IsDate(Sh.Name) Then
DatumTBl = CDate(Sh.Name)
Anzeigen = CLng(DatumTBl >= DatumAb And DatumTBl Anzeigen Then Sh.Visible = Anzeigen
If CDate(Sh.Name) = DatumBis Then Sh.Select
End If
Next
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim wsh As Worksheet
Dim Datum As Date
If Not Intersect(Target, Sh.Range("A2:E2")) Is Nothing Then
Cancel = True
Select Case Target.Value
Case "heute": Call AnzeigeTB_Blatt(Date)
Case "": If IsDate(Sh.Name) Then Call AnzeigeTB_Blatt(CDate(Sh.Name) + 1)
Case "alle"
For Each wsh In Me.Worksheets
If IsDate(wsh.Name) Then If wsh.Visible xlSheetVisible Then wsh.Visible = xlSheetVisible
Next
Case Else
End Select
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Address(0, 0) = "C2" Then
If IsDate(Target.Value) Then Call AnzeigeTB_Blatt(Target.Value)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
dim wsh as worksheet
If Target.Address(0, 0) = "C2" Then
if isdate(Target.value) then
for each wsh in me.Worksheets
if isdate(wsh.name) then
if Cdate(wsh.name) = target.value then Exit for
end if
next
if wsh is nothing then
Msgbox "Datum nicht vorhanden"
else
Call AnzeigeTB_Blatt(Target.Value)
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
end if
Else
msgbox "Bitte korrektes Datum eingeben"
end if
end if
end sub