Office: Formeln schützen & Schutz kopieren

Hallo,

ich habe ein Problem...

Und zwar gibt es bei uns Fehlerlisten für jedes Teil. Diese Liste habe ich vor kurzem neu gestaltet... jetzt ist uns aufgefallen (nach >1000 angefangenen Listen...), dass manche User versehentlich in Berechnungsfeldern Entfernen drücken und dann die Formeln weg sind. Daher meine Frage: Wie kann ich die Formeln nachträglich am geschicktesten Schützen. Die Möglichkeit Markieren und über Zellen Formatieren beim Rest die Sperrung aufheben scheidet aus, da dies extremer Aufwand wäre. Kennt da jemand eine Alternative?

Die Folge-Frage hierzu wäre, ob ich diesen Schutz kopieren kann. Die bisherige Fehlerliste ist so aufgebaut, dass für jeden Fehler ein Formular (10 Zeilen) ausgefüllt wird. Dieses Formular kopiere ich mittels VBA-Makro immer unter das zuletzt ausgefüllte. Der Schutz soll hier also übernommen werden.


Wäre absolut klasse wenn mir jemand weiterhelfen könnte.
Bei Unklarheiten kann ich ggf. auch ein File anhängen.


Viele Grüße

 

Hallo,
stehen die Formel in einer Bestimmten Spalte oder in einer Bestimmten Zelle, in einem sich wiederholende Rytmus?

GRuß

 

Ja, klar. Also das Eingabefeld sieht immer identisch aus, wird nur einfach immer unter das zuletzt hinzugefügte wieder kopiert. am ende hat man dann eine liste mit den ganzen eingabeformularen, die exakt gleich aussehen von der form her.

 

Naja also ich würde alle Zellen, erst markieren dann denn Schutz entfernen und dann in einem Makro die Zellen die ich schützen will, wieder Schützen. Wen du einen Bereich kopierst wird die Einstellung Locked = True normalerweise mitkopiert.

Gruß

 

Hallo,

nein, leider wird es über mein Makro nicht mitkopiert.
Gibt es da einen bestimmten Befehl?
So sieht der VBA-Code für den Button mit dem ich das Formular kopiere bisher aus:


Private Sub CommandButton1_Click()
Dim Ende As Range
Set Ende = Range("A65536").End(xlUp)
Range(Ende, Ende.Offset(-19, 18)).Copy Ende.Offset(1, 0)
Range(Ende.Offset(17, 5), Ende.Offset(2, 16)).ClearContents
Range(Ende.Offset(6, 1), Ende.Offset(2, 1)).ClearContents
Ende.Offset(2, 0).ClearContents
Ende.Offset(18, 1).ClearContents
Range(Ende.Offset(19, 1), Ende.Offset(20, 16)).ClearContents
End Sub



Eine generelle Formel-Schutz-Funktion gibt es nicht?


Vielen Dank bis dahin für die Antworten!

 

Hallo,

dieser Code

Code:

Sub sicherheit()
Dim i As Range
Dim bereich As Range
Set bereich = Range("a1:AA1000")
For Each i In bereich
If i.HasFormula Then
i.Locked = True
End If
Next i
End Sub

aktiviere in allen Zellen ("A1:AA1000") wo eine Formel steht den Schutz("Gesperrt).
Du solltest davor den Bereich anpassen und bei allen Zellen den Schutz erstmal entfernen.

Gruß

 

Hallo,

ansich ist das genau das was ich wollte. Allerdings habe ich noch 2 Probleme:

1. Wie füge ich den Code in den bzw. zu dem des bisherigen Buttons ein, damit ich nur einen Button drücken muss und nach dem Kopieren direkt der Schutz drauf geht?

2. Momentan lässt sich Dein Code nur ausführen, wenn es keinen Blattschutz gibt. Das ist schlecht. Die ganze Tabelle sollte ansich im Blattschutz-modus funktionieren. Sprich, die Formulare kopieren und eben als neue Funktion alle Formeln schützen. Als Fehler, wenn man den Code im geschützten Modus ausführt, kommt: "Laufzeitfehler '1004': Die Locked-Eigenschaft des Range Objekts kann nicht festgelegt werden"


Wenn Du mir bei denen 2 Punkten noch weiterhelfen könntest wär ich absolut glücklich. Vielen Dank bisher für deine Mühen!

 

Hallo,

dazu musst du im oberen Teil des Codes, den Blattschutz deaktivieren und ihn am Ende wieder aktivieren. zusätzlich solltest du innerhalb des
Codes noch alle Zellen entsperren, damit dann nur die Zellen gesperrt werden wo Formeln enthalten.

Code:

Sub schützen()
ActiveSheet.Unprotect

Dim Ende As Range
Set Ende = Range("A65536").End(xlUp)
Range(Ende, Ende.Offset(-19, 18)).Copy Ende.Offset(1, 0)
Range(Ende.Offset(17, 5), Ende.Offset(2, 16)).ClearContents
Range(Ende.Offset(6, 1), Ende.Offset(2, 1)).ClearContents
Ende.Offset(2, 0).ClearContents
Ende.Offset(18, 1).ClearContents
Range(Ende.Offset(19, 1), Ende.Offset(20, 16)).ClearContents

Cells.Locked = False

Dim i As Range
Dim bereich As Range
Set bereich = Range("a1:AA1000")
For Each i In bereich
If i.HasFormula Then
i.Locked = True
End If
Next i

ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Gruß

 

Grandios. Funktioniert perfekt.

Vielen vielen Dank!