Option Explicit
Private Const cBLTNAME = T1->Name des überwachten Blattes
Private Const cZ_ERSTEWERTEZEILE = 2->Werte ab Zeile 2
Private Const cSP_DATUM = 4 ->Spalte D
Private Const cSP_TEXT = 1 ->Spalte A
'**************************************************
Private Sub Workbook_BeforeClose(Cancel As Boolean)
->*** Blatt ganz verstecken, damit ohne Makro nichts verändert werden kann
ThisWorkbook.Worksheets(cBLTNAME).Visible = xlSheetVeryHidden
ThisWorkbook.Save->speichern, damit keine Nachfrage
End Sub
'**************************************************
Private Sub Workbook_Open()
->*** Blatt sichtbar machen
ThisWorkbook.Worksheets(cBLTNAME).Visible = xlSheetVisible
ThisWorkbook.Worksheets(cBLTNAME).Activate
ThisWorkbook.Saved = True
End Sub
'**************************************************
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Zelle As Range
Dim bGefunden As Boolean
->überwachtes Blatt ?
If Sh.Name = cBLTNAME Then
->Änderung eines Datums ? ab Zeile 2, Spalte Datum
bGefunden = False
For Each Zelle In Target
If Zelle.Column = cSP_DATUM Then
If Zelle.Row >= cZ_ERSTEWERTEZEILE Then
->ja
bGefunden = True
Exit For
End If
End If
Next
->Änderung eines Datums ? ja:-> undo und Ende
If bGefunden Then
->Ereignisse abschalten, da sonst das undo ein erneuten Event erzeugt
Application.EnableEvents = False
->undo
Application.Undo
->Ereignisse anschalten
Application.EnableEvents = True
GoTo AUFRAEUMEN
End If
->Änderungen in Text-Zellen ? ab Zeile 2, Spalte Text
For Each Zelle In Target
If Zelle.Column = cSP_TEXT Then
If Zelle.Row >= cZ_ERSTEWERTEZEILE Then
->ja
->Datum noch nicht gesetzt ?
If Sh.Cells(Zelle.Row, cSP_DATUM).Value = Then
->ja -> Datum heute() setzen
->Ereignisse abschalten, da sonst das Event erzeugt wird
Application.EnableEvents = False
->Zelle für Datum formatieren und Datum einsetzen
With Sh.Cells(Zelle.Row, cSP_DATUM)
.NumberFormat = dd.mm.yyyy
.Value = Now()
End With
->Ereignisse anschalten
Application.EnableEvents = True
End If
End If
End If
Next
End If
AUFRAEUMEN:
Set Zelle = Nothing
End Sub
