Hallo,

wie kann ich per Makro alle Zellen in der gesamten Arbeitsmappe die eine
Formel enthalten schützen und alle anderen Zellen freischalten?

Gruss
Charly Prümm

servus.

hier mal n beispielcode. alle anderen zellen werden freigegeben und
nur die mit formel (kennzeichen "=") werden gesperrt und die formeln
ausgeblendet. danach wird das ganze blatt mit "abc" gesperrt.

Sub formeln_sperren()
ActiveSheet.UsedRange.Select
selection.Locked = False
' Befehl für Formel anzeigen ist FormulaHidden
selection.FormulaHidden = False
For Each Zelle In Selection
If InStr(1, CStr(Zelle.Formula), "=") <> 0 Then
Zelle.Locked = True
Zelle.FormulaHidden = True
End If
Next Zelle
ActiveSheet.Protect ("abc")
End Sub

On 2 Nov., 09:27, "Charly Pruemm" <kpru...*t-online.de> wrote:

> wie kann ich per Makro alle Zellen in der gesamten Arbeitsmappe die eine
> Formel enthalten schützen und alle anderen Zellen freischalten?
Ich weiß nicht ob Du mit dem Beispielcode klarkommst, der zudem nicht
ganz das macht was Du möchtest, daher biete ich mal eine fertige
Alternative an.

Andreas.

Sub SetzeFormelschutz()
'Setzt in der ganzen Mappe den Zellschutz bei allen Zellen _
mit Formeln, gibt alle anderen frei
Dim S As Worksheet, Pwd As String
Dim SaveProtectContents As Boolean, SaveEnableEvents As Boolean

'Ereignis-Status sichern und aus, sonst laufen ggf. riesige _
Schleifen in den SelectionChange-Ereignissen ausgelöst _
durch SpecialCells!
SaveEnableEvents = Application.EnableEvents
Application.EnableEvents = False

'Durchlaufe alle Blätter
For Each S In Sheets
'Schutzstatus sichern
SaveProtectContents = S.ProtectContents

'Ist das Blatt geschützt?
If S.ProtectContents Then
'Versuche Schutz zu entfernen
Pwd = ""
On Error Resume Next
Do
S.Unprotect Pwd
'Erfolgreich?
If S.ProtectContents Then
'Nein, Passwort abfragen
S.Activate
Pwd = InputBox("Passwort für " & S.Name, _
"Blattschutz aufheben")
End If
'Wiederhole bis Abbruch oder Blatt ungeschützt
Loop Until Len(Pwd) = 0 Or Not S.ProtectContents
'Fehler an
On Error GoTo 0
End If

'Blatt ungeschützt?
If Not S.ProtectContents Then
'Gebe Zellen frei
S.Cells.Locked = False
'Fehler aus, evt. keine Formeln vorhanden
On Error Resume Next
'Setze Schutz bei Formeln
S.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
'Fehler an
On Error GoTo 0
'Ggf. Schutz wieder setzen
If SaveProtectContents Then S.Protect Pwd
End If
Next

'Ggf. Ereignisse an
Application.EnableEvents = SaveEnableEvents
End Sub