Private
Sub
Enter()
Application.ScreenUpdating =
False
If
Not
ActiveCell = Range(
"D39"
)
And
Not
ActiveCell = Range(
"D40"
)
And
Not
ActiveCell = Range(
"G39"
)
And
Not
ActiveCell = Range(
"G40"
)
Then
If
CheckError.IsError(Selection)
Then
Exit
Sub
ActiveSheet.Unprotect Password:=
"0444786400"
With
Selection
.Font.ThemeColor = xlThemeColorDark1
.Font.TintAndShade = 0
.Borders(xlEdgeLeft).Weight = xlThick
.Borders(xlEdgeRight).Weight = xlThick
.Borders(xlEdgeTop).Weight = xlThick
.Borders(xlEdgeBottom).Weight = xlThick
End
With
ActiveSheet.Protect DrawingObjects:=
True
, Contents:=
True
, Scenarios:=
True
, Password:=
"0444786400"
Range(
"D39"
).
Select
SendKeys
"{F2}"
,
True
SendKeys
"+(^{LEFT})"
ElseIf
ActiveCell = Range(
"D39"
)
Then
Range(
"D40"
).
Select
SendKeys
"{F2}"
,
True
SendKeys
"+(^{LEFT})"
ElseIf
ActiveCell = Range(
"D40"
)
Then
If
Range(
"AB1"
).Value =
True
Then
Range(
"I34:L34"
).
Select
Answer = MsgBox(
"Änderungen für Auswahl übernehmen?"
, vbYesNo,
"Änderungen übernehmen"
)
If
Answer = vbYes
Then
Dateisystem.Speichern
Else
Range(Range(
"C36"
).Value).
Select
End
If
Else
Range(
"G39"
).
Select
SendKeys
"{F2}"
,
True
SendKeys
"+(^{LEFT})"
End
If
ElseIf
ActiveCell = Range(
"G39"
)
Then
Range(
"G40"
).
Select
SendKeys
"{F2}"
,
True
SendKeys
"+(^{LEFT})"
ElseIf
ActiveCell = Range(
"G40"
)
Then
Range(
"I34:L34"
).
Select
Answer = MsgBox(
"Änderungen für Auswahl übernehmen?"
, vbYesNo,
"Änderungen übernehmen"
)
If
Answer = vbYes
Then
Dateisystem.Speichern
Else
Range(Range(
"C36"
).Value).
Select
End
If
End
If
End
Sub