Zellen sperren

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Mldg As Byte
If ActiveWorkbook.Saved Then
Sheets("Sheet1").Visible = True
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Sheet1" 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("Sheet1").Visible = True
For InI = Sheets.Count To 1 Step -1
If Sheets(InI).Name <> "Sheet1" 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("Sheet1").Visible = False
For Sh = 1 To Sheets.Count
If Left(Sheets(Sh).Name, 9) = "Folienbestand " Then
Sp = Sp + 1
Sheets("Folienbestand " & Sp).Unprotect ("Excel")
Sheets("Folienbestand " & Sp).Cells.SpecialCells(xlCellTypeConstants, 23).Locked = True
Sheets("Folienbestand " & Sp).Cells.SpecialCells(xlCellTypeFormulas, 23).Locked = True
Sheets("Folienbestand " & Sp).Cells.SpecialCells(xlCellTypeBlanks).Locked = False
Sheets("Folienbestand " & Sp).Protect ("Excel")
End If
Next Sh
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
End Sub