AW: Zellen anhand einer Vorauswahl sperren
23.02.2021 07:45:36
Benny
Hallo Val,
wahrscheinlich hast du recht. Ich habe mich mal versucht. Ich versuche mal das zuu beschreiben was ich bisher davon verstanden habe:
In diesem Block werden die Zellen von D1 bis M1 ausgewählt, wenn die Spalte Nr 3 ist und die Zeile entweder 2 oder größer ist (damit die Überschrift nicht mit gewählt wird).
Wenn die Bedingungen zutreffen, wird erlaubt Code auszuführen (EnableEvents), das Passwort wird gesetzt und diese Zeile verstehe ich nicht:
ZelleDavor.Range("D1:M1").ClearContents 'relative Adresse!
Dann ruft er die Funktion Zellen_sperren auf und übergibt dort den Inhalt des gerade ausgewählten Case.
Mein Problem ist, dass ich nicht genau weiß wo ich den default wert setzen muss. Ich habe es jetzt mal versucht und die Abfrage nach dem Case gestaltet. Dann einen neuen Case inzugefügt der leer ist und als Wert 10 x die 2 zurück gibt.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static ZelleDavor As Range
On Error GoTo Catch
Try:
If ZelleDavor.Column = 3 And ZelleDavor.Row >= 2 Then
Application.EnableEvents = False
ActiveSheet.Unprotect Password:="test"
ZelleDavor.Range("D1:M1").ClearContents 'relative Adresse!
Zellen_sperren ZelleDavor
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=" _
test"
Application.EnableEvents = True
End If
Catch:
Finally:
Set ZelleDavor = Target
End Sub
Sub Zellen_sperren(Zelle)
Dim List, i
List = Replace(List, " ", "")
Select Case Zelle.Value
Case "": List = "2222222222"
Case "Neueröffnung": List = "0010000000"
Case "Inhaberwechsel": List = "0000000000"
Case "Umfirmierung": List = "0000000000"
Case "Schließung": List = "0100011111"
Case "KK Auftrag": List = "0111111000"
Case "KK Eingang": List = "0111110000"
'case "xy": list = "..." '0:offen, 1:gesperrt
Case Else: List = "0000000000"
List = Replace(List, " ", "")
End Select
For i = 1 To Len(List)
If List = 2222222222# Then
Zelle.Offset(0, i).Locked = True
Zelle.Offset(0, i).Interior.ColorIndex = False
Else
Zelle.Offset(0, i).Locked = CBool(Mid(List, i, 1))
Zelle.Offset(0, i).Interior.ColorIndex = 35 - 13 * CInt(Mid(List, i, 1)) '22:rot, 35:grü _
n
End If
Next
End Sub
Kannst ja mal schauen. Für mich scheint es zu funktionieren aber manchmal sind Funktionen ja sehr quer und gehen auf die Computer Last.
Danke nochmal das du mich dazu animiert hast. Wenn man was für die Arbeit macht hat man oft nicht die Zeit sich damit so intensiev zu beschäftigen. Ich mache vba leider zu selten.
