Ich suche nach einer Möglichkeit, (fast)alle Zellen eines Blattes komplett (ok, macht der Blattschutz) und bestimmte Zellen nur teilweise zu schützen.
Für letztere soll möglich sein: Inhaltsänderung, Schriftformatierung und Zéllenzusammenfassung mit anderen teilweise freigegebenen Zellen. Für alle anderen Änderungsmöglichkeiten soll der Blattschutz voll greifen. Insbesondere soll es nicht möglich sein, diese Zellen (Zelle selbst, nicht Inhalt, das wäre ok) zu löschen bzw. in den Bereichen Zellen einzufügen.
Hat evtl. jemand sowas parat oder kann mir auf die Spünge helfen?
Der Code, den ich geschrieben habe ist mir ein zu großer Eingriff in die Application, ich befürchte Quereffekte auf andere Dateien und das Verhalten der Application.
Mein Code:
In den Sheets:
Option Explicit
Private Sub Worksheet_Activate()
SchutzAn
EinfAnAus (False)
End Sub
Private Sub Worksheet_Deactivate()
EinfAnAus (True)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
EinfAnAus (False)
If Not Target.Cells.Locked Then
SchutzAus
Else
SchutzAn
End If
End Sub
Im Codemodul:
Option Explicit
Sub SchutzAn()
ActiveSheet.Protect "geheim", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub SchutzAus()
ActiveSheet.Unprotect "geheim"
End Sub
Sub EinfAnAus(State As Boolean)
On Error GoTo ende
With Application
.CommandBars("Worksheet Menu Bar").FindControl(ID:=295, Recursive:=True).Enabled = State
.CommandBars("Worksheet Menu Bar").FindControl(ID:=296, Recursive:=True).Enabled = State
.CommandBars("Worksheet Menu Bar").FindControl(ID:=297, Recursive:=True).Enabled = State
.CommandBars("Cell").FindControl(ID:=292, Recursive:=True).Enabled = State
.CommandBars("Row").FindControl(ID:=293, Recursive:=True).Enabled = State
.CommandBars("Column").FindControl(ID:=294, Recursive:=True).Enabled = State
.CommandBars("Cell").FindControl(ID:=3181, Recursive:=True).Enabled = State
.CommandBars("Row").FindControl(ID:=3183, Recursive:=True).Enabled = State
.CommandBars("Column").FindControl(ID:=3183, Recursive:=True).Enabled = State
End With
ende:
End Sub
Für das Aufzeigen möglicher Probleme mit dem Code, Änderungstips usw. bin ich sehr dankbar!
Gruß
Peter