AW: Zellen nach eingabe von Werten automatisch sperren
Werten
Hallo zusammen
Ich möchte mich bei allen bedanken die mir mit Rat und Tat zur Seite standen und mein Problem gelöst haben. Insbesonder bedanke ich mich bei AndrèL, Silvio, Excel und Martin Beck. Damit alle etwas von der Lösung haben, stelle ich hier den Code ein, der von Excel erstellt von Martin Beck den entscheidenden Hinweisgegeben und von Andrè vollendet wurde. Meine wenigkeit hat alles nur getestet und mich in den meisten Fällen beklagen müssen das es immer noch nicht läuft. Sollte ich dabei jemandem zu nahe getreten sein, entschuldige ich mich hiermit.
Der Lösungs Code lautet wie folgt
Dim InI As Integer
Dim ByS As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Mldg As Byte
If ActiveWorkbook.Saved Then
Sheets("Tabelle1").Visible = True
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Tabelle1" Then Sheets(InI).Visible = xlVeryHidden
Next InI
ByS = True
ThisWorkbook.Save
Else
If ByS = True Then Exit Sub
Mldg = MsgBox(" Sollen die Veränderungen gespeichert werden ?", _
vbYesNo + vbQuestion, "Speicher abfrage ?", "", 0)
If Mldg = 6 Then
Application.ScreenUpdating = False
Sheets("Tabelle1").Visible = True
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Tabelle1" Then Sheets(InI).Visible = xlVeryHidden
Next InI
ByS = True
ThisWorkbook.Save
Application.ScreenUpdating = True
Else
ByS = True
ThisWorkbook.Close False
End If
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If ByS = False Then
Cancel = True
MsgBox "Datei kann nur beim schließen gespeichert werden"
End If
End Sub
Private Sub Workbook_Open()
Application.ScreenUpdating = False
For InI = 1 To Sheets.Count 'To 1 Step -1
Sheets(InI).Visible = True
Next InI
Sheets("Tabelle1").Visible = False
For sh = 1 To Sheets.Count
If Left(Sheets(sh).Name, 9) = "Spieltag " Then
Sp = Sp + 1
Sheets("Spieltag " & Sp).Unprotect ("Excel")
Sheets("Spieltag " & Sp).Cells.SpecialCells(xlCellTypeConstants, 23).Locked = True
Sheets("Spieltag " & Sp).Cells.SpecialCells(xlCellTypeFormulas, 23).Locked = True
Sheets("Spieltag " & Sp).Cells.SpecialCells(xlCellTypeBlanks).Locked = False
Sheets("Spieltag " & Sp).Protect ("Excel")
End If
Next sh
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
End Sub