AW: verbundene Zellen n. Eingabe sperren bei 4Sheets
11.02.2016 16:20:46
Fred
Hallo zusammen,
leider ist mir im nachhinein folgendes aufgefallen. Der Code von Franz funktioniert und sperrt die Zellen nach dem Schließen, aber er hat auch Einfluss auf einen Code unter "Before_Save", was nicht sein darf.
Ich habe folgenden Code unter "Before_Save", welcher bestimmte Zellen prüft und in 4 Zellen das Datum und die Uhrzeit beim Speichern einträgt:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim arWS As Variant, i As Integer
Dim rng As Range
Dim BereichAlle As Range, Bereich1 As Range, Bereich2 As Range, Bereich3 As Range
arWS = Array("erster Prüflauf", "zweiter Prüflauf", "dritter Prüflauf", "vierter Prüflauf")
For i = 0 To UBound(arWS)
Set Bereich1 = Worksheets(arWS(i)).Range("BD57")
Set Bereich2 = Worksheets(arWS(i)).Range("BE57")
Set Bereich3 = Worksheets(arWS(i)).Range("BF57")
Set BereichAlle = Union(Bereich1, Bereich2, Bereich3)
For Each rng In Bereich1
If rng 1 Then
MsgBox "ERSTES Ereignis unvollständig! Bitte alle ROT markierten Pflichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
For Each rng In Bereich2
If rng 1 Then
MsgBox "ZWEITES Ereignis unvollständig! Bitte alle ROT markierten Plichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
For Each rng In Bereich3
If rng 1 Then
MsgBox "DRITTES Ereignis unvollständig! Bitte alle ROT markierten Pflichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
Next i
For i = 0 To UBound(arWS)
Worksheets(arWS(i)).Range("U44").Value = Date
Worksheets(arWS(i)).Range("U101").Value = Date
Worksheets(arWS(i)).Range("U39").Value = Time
Worksheets(arWS(i)).Range("U97").Value = Time
Next i
Application.ScreenUpdating = True
End Sub
Das funktioniert alles super. Aber sobald ich den Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim bolSaved As Boolean
Dim rngCell As Range
Dim wks As Worksheet
On Error Resume Next
bolSaved = Me.Saved
For Each wks In Me.Worksheets
With wks
Select Case wks.Name
Case "Tabelle ABA", "Tab10"
'Diese Tabellenblätter überspringen
Case Else
.Unprotect ("Passwort")
For Each rngCell In .Range("A6:S112").Cells
If rngCell.MergeCells = True Then
rngCell.MergeArea.Locked = rngCell.MergeArea.Range("A1") ""
Else
rngCell.Locked = rngCell.Value ""
End If
Sprungmarke:
Next
.Protect ("Passwort")
End Select
End With
Next wks
If bolSaved = True Then Me.Save
End Sub
...einfüge, aktualisiert er auch beim Schließen das Datum und die Zeit in der Zelle U44 + U101 + U39 + U97, was er aber nur beim Speichern machen sollte!
Ich habe dann versucht, um den Fehler zu umgehen, den Code von Franz mit in die Funktion "Before_Save" einzufügen, da sich das Sperren der Zellen auch beim Speichern anbietet:
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Dim arWS As Variant, i As Integer
Dim rng As Range
Dim BereichAlle As Range, Bereich1 As Range, Bereich2 As Range, Bereich3 As Range
arWS = Array("erster Prüflauf", "zweiter Prüflauf", "dritter Prüflauf", "vierter Prüflauf")
For i = 0 To UBound(arWS)
Set Bereich1 = Worksheets(arWS(i)).Range("BD57")
Set Bereich2 = Worksheets(arWS(i)).Range("BE57")
Set Bereich3 = Worksheets(arWS(i)).Range("BF57")
Set BereichAlle = Union(Bereich1, Bereich2, Bereich3)
For Each rng In Bereich1
If rng 1 Then
MsgBox "ERSTES Ereignis unvollständig! Bitte alle ROT markierten Pflichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
For Each rng In Bereich2
If rng 1 Then
MsgBox "ZWEITES Ereignis unvollständig! Bitte alle ROT markierten Plichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
For Each rng In Bereich3
If rng 1 Then
MsgBox "DRITTES Ereignis unvollständig! Bitte alle ROT markierten Pflichtfelder _
beschriften!"
Cancel = True
Exit Sub
End If
Next rng
Next i
For i = 0 To UBound(arWS)
Worksheets(arWS(i)).Range("U44").Value = Date
Worksheets(arWS(i)).Range("U101").Value = Date
Worksheets(arWS(i)).Range("U39").Value = Time
Worksheets(arWS(i)).Range("U97").Value = Time
Next i
For i = 0 To UBound(arWS)
Dim bolSaved As Boolean
Dim rngCell As Range
Dim wks As Worksheet
On Error Resume Next
bolSaved = Me.Saved
For Each wks In Me.Worksheets
With wks
Select Case wks.Name
Case "Tabelle ABA", "Tab10"
'Diese Tabellenblätter überspringen
Case Else
.Unprotect ("Passwort")
For Each rngCell In .Range("A6:S112").Cells
If rngCell.MergeCells = True Then
rngCell.MergeArea.Locked = rngCell.MergeArea.Range("A1") ""
Else
rngCell.Locked = rngCell.Value ""
End If
Sprungmarke:
Next
.Protect ("Passwort")
End Select
End With
Next wks
If bolSaved = True Then Me.Save
Next i
Application.ScreenUpdating = True
End Sub
...Allerdings hat das nicht funktioniert. :-(
Es gäbe jetzt zwei Lösungsmöglichkeiten, welche ich aber nicht umgesetzt bekomme:
1. Hat jemand eine Idee, wie ich alle drei Merkmale, also: Prüfen + Datum & Urzeit einfügen + Sperren ausgefüllter verbundener Zellen, in die Funktion "Before_Save" bekomme?
2. Weis jemand wie man das weg bekommt, das er das Datum & Uhrzeit aktualisiert wenn man den Code von Franz benutzt?
Vielen Dank schon mal. :-)
Fred