Makros: Bedingte Formatierung trotz Blattschutz?

Computer: Software & Programmierung Visual Basic
#1

Hallo Zusammen
Ich erstelle gerade eine Tabelle die mit mehrer Bedingungen unterschiedliche Formatierungen hervorrufen soll.
Den entsprechenden Code habe ich nach einigem Suchen gefunden. (Kenn mich gar nicht aus mit diesen VBA-Codes)

Nun ist es so, dass wenn ich das Arbeitsblatt schütze, wird der Code nicht mehr umgesetzt. Gibt es eine Erweiterung, damit dies doch noch funktionieren kann?

Hier mein Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range(„B6:M41, B46:F61“)
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then

Select Case UCase(RaZelle.Value)
Case „SP“
RaZelle.Interior.ColorIndex = 45
Case „ABU“
RaZelle.Interior.ColorIndex = 6
Case „BK“
RaZelle.Interior.ColorIndex = 4
Case „üK“
RaZelle.Interior.ColorIndex = 34
Case „PIV“
RaZelle.Interior.ColorIndex = 38
Case „ST“
RaZelle.Interior.ColorIndex = 37
Case Else
RaZelle.Interior.ColorIndex = xlNone
End Select

End If
Next RaZelle
Set RaBereich = Nothing
End Sub

Vielen Dank für eure Hilfe

#2

Hallo cookie11,

so weit ich weiß, geht das was du möchtest nicht.
wenn ein arbeitsblatt per kennwort gesperrt ist, dann hat auch ein makro keinen zugriff mehr darauf.

es gibt die möglichkeit, dass kennwort per vba-code wieder zu entfernen und am ende wieder zu setzen, aber da müsste ich mal nachlesen, wie das war.

hoffe ich konnte dir mit der antwort ersteinmal weiterhelfen.

freue mich über eine rückantwort

mfg
daniel

#3

Besten Dank für diese erste Antwort. Ich habe nach weiterer langer Suche im Netz einen entsprechenden Code entdeckt, welcher mir weitergeholfen hat.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
ActiveSheet.Unprotect Password:=„Test“
…
ActiveSheet.Protect Password:=„Test“
End Sub

Ich konnte mir leider nicht selbst Antworten. :smile:

Gleich eine weitere Frage:
Kann man durch die Eingabe eines bestimmten Textes die Zelle sperren lassen?

z.B. Es wird „üK“ eingesetzt und anschliessend lässt sich diese Zelle nicht mehr auswählen, ausser man hebt den Blattschutz wieder auf. Bei anderen Eingaben sollte die Zelle frei bearbeitbar bleiben.

#4

Hallo,

ich habe mal ein wenig code zusammengeschrieben:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address = „$A$1“ And Target = 2 Then
ActiveSheet.Unprotect 'Blattschutz entfernen
Cells.Locked = False 'ALLE Zellen entsperren
Target.Locked = True 'Zelle sperren
ActiveSheet.Protect 'Blattschutz setzen
End If

'Bewirkt, dass nur die angegebene Zelle gesperrt ist,
'alle anderen Zellen sind freizugänglich

End Sub

Bei weiteren Fragen, einfach her damit :smile:

mfg

#5

was vergessen:
statt Target=2 musst du natürlich Target=ük" schreiben

#6

Vielen Dank für deine Hilfe. Leider klapt der neue Code nicht. :-c

Den Blattschutz habe ich weggelassen, da er am Anfang aufgehoben bzw. am Ende geschützt wird. Grundsätzlich muss ja nur beim Wort „ük“ die Zelle gesperrt werden. Alles andere ist schon eingestellt.

Ich habe den Code wiefolgt eingegeben:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
ActiveSheet.Unprotect Password:=„test“
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range(„B6:M41, B46:F61“)
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
Select Case UCase(RaZelle.Value)
Case „SP“
RaZelle.Interior.ColorIndex = 45
Case „ABU“
RaZelle.Interior.ColorIndex = 6
Case „BK“
RaZelle.Interior.ColorIndex = 4
Case „üK“
RaZelle.Interior.ColorIndex = 34
Case „PIV“
RaZelle.Interior.ColorIndex = 38
Case „ST“
RaZelle.Interior.ColorIndex = 37
Case „0“
RaZelle.Interior.ColorIndex = 16
RaZelle.Font.ColorIndex = 16
Case Else
RaZelle.Interior.ColorIndex = xlNone
End Select
End If

If Target.Address = „B6:M41, B46:F61“ And Target = „üK“ Then
Cells.Locked = False
Target.Locked = True
End If

Next RaZelle
Set RaBereich = Nothing
ActiveSheet.Protect Password:=„test“
End Sub

Habe ich was falsch gemacht? Vielen Dank

#7

Moin…

Ich habs geschafft! Und das erstaunlicherweise ohne irgendwelche vorkenntnisse. Hehe.
(Das nur auf das „ü“ reagiert der Code nicht)

Private Sub worksheet_change(ByVal target As Excel.Range)
ActiveSheet.Unprotect Password:=„Test“
Dim RaBereich As Range, RaZelle As Range
Set RaBereich = Range(„B6:M41, B46:F61“)

For Each RaZelle In Range(target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then

Select Case UCase(RaZelle.Value)
Case „SP“
RaZelle.Interior.ColorIndex = 45
target.Locked = False
Case „ABU“
RaZelle.Interior.ColorIndex = 6
target.Locked = False
Case „BK“
RaZelle.Interior.ColorIndex = 4
target.Locked = False
Case „üK“
RaZelle.Interior.ColorIndex = 34
target.Locked = True
Case „PIV“
RaZelle.Interior.ColorIndex = 38
target.Locked = False
Case „ST“
RaZelle.Interior.ColorIndex = 37
target.Locked = True
Case „0“
RaZelle.Interior.ColorIndex = 16
RaZelle.Font.ColorIndex = 16
target.Locked = False
Case Else
RaZelle.Interior.ColorIndex = xlNone
target.Locked = False
End Select
End If
Next RaZelle
Set RaBereich = Nothing
ActiveSheet.Protect Password:=„Test“
End Sub

#8

Hallo Zusammen
Ich erstelle gerade eine Tabelle die mit mehrer Bedingungen
unterschiedliche Formatierungen hervorrufen soll.
Den entsprechenden Code habe ich nach einigem Suchen gefunden.
(Kenn mich gar nicht aus mit diesen VBA-Codes)

Nun ist es so, dass wenn ich das Arbeitsblatt schütze, wird
der Code nicht mehr umgesetzt. Gibt es eine Erweiterung, damit
dies doch noch funktionieren kann?

Hier mein Code:

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RaBereich As Range, RaZelle As Range
Set RaBereich =workbooks(„Mappe1“).Worksheets(„Tabelle1“).Range(„B6:M41, B46:F61“)
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing Then

Select Case UCase(RaZelle.Value)
Case „SP“
RaZelle.Interior.ColorIndex = 45
Case „ABU“
RaZelle.Interior.ColorIndex = 6
Case „BK“
RaZelle.Interior.ColorIndex = 4
Case „üK“
RaZelle.Interior.ColorIndex = 34
Case „PIV“
RaZelle.Interior.ColorIndex = 38
Case „ST“
RaZelle.Interior.ColorIndex = 37
Case Else
RaZelle.Interior.ColorIndex = xlNone
End Select

End If
Next RaZelle
Set RaBereich = Nothing
End Sub

Vielen Dank für eure Hilfe

Hallo cookie11,
habe hier nicht wirklich Ahnung genug, Dir ohne wirklich längere Recherchen und Versuche weiterhelfen zu können. Falls Du´s nicht schon probiert hast, setze unter Extras-Makro-Sicherheit die Einstellung auf „Niedrig“ bevor Du die geschützte Arbeitsmappe öffnest und kontrollier das, nachdem sie geöffnet worden ist.
Ich habe den Code oben mal ergänzt um direkte Bezüge zu „Mappe1“ und „Tabelle1“, wobei „Mappe1“ durch den Namen der Xls-Datei ersetzen solltest („MeineDatei.xls“) und „Tabelle1“ durch den Namen des Arbeitsblattes wie es auf dem Arbeitsblattreiter unten steht. U.U. bezieht sich ein VBA-Code nicht auf eine geschützte Mappe/Arbeitsblatt, wenn man den Code nicht ausdrücklich auf diese Mappe/das Blatt hin dirigiert. Zudem hat die Methode den Vor-/ oder Nachteil, dass der Code sich immer nur auf die Mappe, das Blatt bezieht, für das er geschrieben wurde und nicht auf andere Blätter oder Mappen, die man in Excel u.U. gleichzeitig auch noch geöffnet hat.
Gruß
Frank

#9

Hallo Frank
Ich konnte mittlerweile den ganzen Code generieren und es klappt einwandfrei. (ActiveSheet.Unprotect & ActiveSheet.Protect)
Ich konnte sogar noch ergänzen dass einzelne Zellen nachträglich gesperrt werden wenn man gewisse Wörter eingibt.

Besten Dank für deinen Lösungsansatz. Evtl. ergänze ich noch die genauen Bezüge zur Arbeitsmappe bzw. Tabellenblatt.

#10

Hallo Cookie,

da Dein code reagieren soll bei Änderungen (worksheet_change), kann das schlecht funktionieren, wenn Dein Arbeitsblatt gechützt ist, denn dann willst Du ja genau vermeiden, dass Änderungen gemacht werden.
Du kannst aber über Menue Format-Zellen-Zellschutz den Schutz für bestimmte Zellen und Bereich aufheben, so dass der Code bei ungeschützen Zellen ausgeführt werden sollte. Ich arbeite allerdings nur noch mit LibreOffice und bin ansonsten eher in Access-Anwendungen zu Hause. Viel Erfolg
Uli