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
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen