Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
On
Error
Resume
Next
If
Not
Application.Intersect(Range(
"L8:M1000"
), Target)
Is
Nothing
Then
Select
Case
UCase$(Target.Value)
Case
"NB"
MsgBox
"Begründung warum keine Schulung benötigt wird unter Bemerkung eintragen."
, _
vbOKOnly + vbExclamation,
"Sicherheitsschulung nicht benötigt!"
Case
".NEIN"
MsgBox
"Begründung warum Ausweis nicht Kontrolliert wurde unter Bemerkung eintragen."
&
""
_
& vbCrLf &
""
, vbOKOnly + vbExclamation,
"Keine Ausweiskontrolle!"
Case
"NEIN"
MsgBox
"Es wird eine Schulung oder ein Refresh benötigt."
&
""
_
& vbCrLf &
"Kontaktperson darüber informieren und die entsprechenden Dokumente vorbereiten."
, _
vbOKOnly + vbExclamation,
"Sicherheitschulung nicht vorhanden / abgelaufen!"
End
Select
End
If
If
Not
Intersect(Target, Range(
"D8:D1000,Q8:P1000"
))
Is
Nothing
Then
If
Target.Count > 1
Then
Exit
Sub
Application.EnableEvents =
False
If
Target.Value =
"Name1"
Or
Target.Value =
"Name2"
_
Or
Target.Value =
"Name3"
_
Or
Target.Value =
"Name4"
_
Or
Target.Value =
"Name5"
_
Or
Target.Value =
"Name6"
Then
Target.Offset(0, 1) = Format(
Date
,
"dd.mm.yyyy"
)
Target.Offset(0, 2) = Format(Time,
"hhmm"
)
Else
Target.Offset(, 1).Resize(, 2).ClearContents
End
If
Application.EnableEvents =
True
End
If
On
Error
GoTo
0
End
Sub