Makro fuer Zellschutz automatisch aufheben und einsetzen

[FR-CGI]

Hallo,

Ich suche ein Makro was automtisch den Zellschutz aufhebt und dann ein Makro was den Zellschutz wieder automatisch aktiviert.
Es sollen aber nur die Zellen geschuetzt werden, die Formeln enthalten.
Das ganze fuer all sheets im active workbook.
ich habe den code gefunden um den Zellschutz aufzuheben

Code:

Sub Schutz_Aufheben()
Dim i As Integer
For i = 1 To Sheets.Count
ActiveWorkbook.Sheets(i).Unprotect Password:="Treasury"
Next
MsgBox "alle Blätter wurden vom Blattschutz befreit"
End Sub

das klappt auch aber wenn ich den Zellschutz dann wieder reinpacke, schuetzt es alle Zellen. Es soll aber nur die Zellen mit Formeln schuetzen
Hat da jemand eine Idee um was ich den Code ergaenzen muss damit nur Zellen mit Formeln geschuetzt werden?
Vielen Danke

Code:

Sub Blatt_Schutz()
Dim i As Integer
For i = 1 To Sheets.Count
ActiveWorkbook.Sheets(i).Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Treasury"
Next
   ActiveWorkbook.Save
   ActiveWorkbook.Save
MsgBox "alle Blätter wurden geschützt"
End Sub

[Rabe]

Hi,

das klappt auch aber wenn ich den Zellschutz dann wieder reinpacke, schuetzt es alle Zellen. Es soll aber nur die Zellen mit Formeln schuetzen
Hat da jemand eine Idee um was ich den Code ergaenzen muss damit nur Zellen mit Formeln geschuetzt werden?

Du kannst in der Zellformatierung die Zellen mit Formeln bei "Schutz" mit Haken versehen und alle anderen ohne Haken. Dann Blattschutz.

[Kuwer]

Hallo,

Sub NurFormelnSchuetzen()

 Dim i As Integer

 For i = 1 To Worksheets.Count

   With Worksheets(i)

     .Unprotect Password:="Treasury"

     .Cells.Locked = False

     .Cells.SpecialCells(xlCellTypeFormulas).Locked = True

     .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Treasury"

   End With

 Next

End Sub

Gruß Uwe

[FR-CGI]

Code:

.Cells.SpecialCells(xlCellTypeFormulas).Locked = True

Danke Uwe,

ich bekommen immer den Laufzeitfehler 1004.
Habe aber 1:1 den Code von dir uebernommen?

[FR-CGI]

ich kann aber mit dem Lauftzeitfehler leben..
ich druecke einfach auf Beenden und die Zellen sind dennoch geschuetzt

Danke

[FR-CGI]

Nope, sorry

das Makro schuetzt nicht alle worksheets und Zellen mit Formeln des Activeworkbooks?

[Kuwer]

Hallo,

so sollte es durchlaufen:

Sub NurFormelnSchuetzen()

 Dim i As Integer

 On Error Resume Next

 For i = 1 To Worksheets.Count

   With Worksheets(i)

     .Unprotect Password:="Treasury"

     .Cells.Locked = False

     .Cells.SpecialCells(xlCellTypeFormulas).Locked = True

     .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="Treasury"

   End With

 Next

 On Error GoTo 0

End Sub

Gruß Uwe

[FR-CGI]

Danke Uwe,

wollte gerade schreiben..der MakroRekorder hat es auch gemacht. Doof von mir, warum ich den nicht gleich genutzt habe.
Deine letzte Leosung funktioniert.

Danke