VBA: Zellen Sperren wenn Spalte ein Nein enthält

[dondraper]

Hallo Liebe VBA-Experten,

ich möchte das in der gesamten Arbeitsmappe die Spalte H grau und gesperrt wird wenn in Spalte G das Wort Nein steht (mittels dropdown und wenn möglich NUR wenn das Wort Nein steht). Dasselbe soll gelten für Spalte J (wenn Nein) dann Spalte K Grau und gesperrt.

Ich habe folgenden Code gefunden jedoch funktioniert er nur für ein Tabellenblatt (sorry VBA Kenntnisse beschränken sich bei aus Copy und Paste )

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Range("B2") = "Nein" Then
   ActiveSheet.Unprotect
   ActiveSheet.Range("C1:C2").Select
     With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .ThemeColor = xlThemeColorDark1
       .TintAndShade = -0.249946592608417
       .PatternTintAndShade = 0
    End With
    With Selection
       .Locked = True
   End With
   Else
   ActiveSheet.Unprotect
   ActiveSheet.Range("C1:C2").Interior.ColorIndex = xlNone
   ActiveSheet.Range("C1:C2").Locked = False
End If
   ActiveSheet.Protect
End Sub

Kann mir jemand sagen wie ich den Code umschreiben kann, damit er für die gewünschten Spalten und die gesamte Arbeitsmappe gilt?

Vielen Dank schonmal!!!

Viele Grüße
Don

[dondraper]

Hallo Liebe VBA-Experten,

ich möchte das in der gesamten Arbeitsmappe die Spalte H grau und gesperrt wird wenn in Spalte G das Wort Nein steht (mittels dropdown und wenn möglich NUR wenn das Wort Nein steht). Dasselbe soll gelten für Spalte J (wenn Nein) dann Spalte K Grau und gesperrt.

Ich habe folgenden Code gefunden jedoch funktioniert er nur für ein Tabellenblatt (sorry VBA Kenntnisse beschränken sich bei aus Copy und Paste )

Private Sub Worksheet_Change(ByVal Target As Range)
If ActiveSheet.Range("B2") = "Nein" Then
   ActiveSheet.Unprotect
   ActiveSheet.Range("C1:C2").Select
     With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .ThemeColor = xlThemeColorDark1
       .TintAndShade = -0.249946592608417
       .PatternTintAndShade = 0
    End With
    With Selection
       .Locked = True
   End With
   Else
   ActiveSheet.Unprotect
   ActiveSheet.Range("C1:C2").Interior.ColorIndex = xlNone
   ActiveSheet.Range("C1:C2").Locked = False
End If
   ActiveSheet.Protect
End Sub

Kann mir jemand sagen wie ich den Code umschreiben kann, damit er für die gewünschten Spalten und die gesamte Arbeitsmappe gilt?

Vielen Dank schonmal!!!

Viele Grüße
Don

Echt keiner???? :(

[Rabe]

Hi Don,

Echt keiner???? :(

weißt Du, die meisten machen das hier in ihrer Freizeit und die wenigsten sind Rentner, die (tagsüber) ja auch keine Zeit haben. Heute abend wird sich sicher jemand drum kümmern.

[Rabe]

Kann mir jemand sagen wie ich den Code umschreiben kann, damit er für die gewünschten Spalten und die gesamte Arbeitsmappe gilt?

so, setze folgendes Makro hinter "DieseArbeitsmappe":

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If ActiveSheet.Range("B2") = "Nein" Then
        ActiveSheet.Unprotect
        ActiveSheet.Range("H:H").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.249946592608417
            .PatternTintAndShade = 0
        End With
        With Selection
            .Locked = True
        End With
    Else
        ActiveSheet.Unprotect
        ActiveSheet.Range("H:H").Interior.ColorIndex = xlNone
        ActiveSheet.Range("H:H").Locked = False
    End If
    If ActiveSheet.Range("J2") = "Nein" Then
        ActiveSheet.Unprotect
        ActiveSheet.Range("K:K").Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = -0.249946592608417
            .PatternTintAndShade = 0
        End With
        With Selection
            .Locked = True
        End With
    Else
        ActiveSheet.Unprotect
        ActiveSheet.Range("K:K").Interior.ColorIndex = xlNone
        ActiveSheet.Range("K:K").Locked = False
    End If
    ActiveSheet.Protect

End Sub

VBA/HTML - CodeConverter für Office-Foren, AddIn für Excel/Word 2000-2013 - komplett in VBA geschrieben von Lukas Mosimann. Projektbetreuung durch mumpel
Code erstellt und getestet in Office 15

Das geht sicher kürzer!

[schauan]

Hallo Don,

wenn Du so schnell eine Antwort möchstest, würden wir uns auch über eine schnelle Rückmeldung freuen, ob denn unsere Vorschläge zu Deiner Excel-Aufgabe passen ... Hier wäre mal meine optimierte Variante, Funktion siehe Kommentare.
Übrigens lautete die Aufgabe, dass die Färbung bei EIntrag von Nein in der Spalte daneben erfolgt. Ich habe es auch bei mir auf Zelle 2 in der Spalte belassen.

Microsoft Excel Objekt DieseArbeitsmappe

Option Explicit 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
'Variablendeklarationen 
'Integer 
Dim iCnt% 
'Variant - Array 
Dim strSpalt 
'Array aus Spaltennummern bilden 
strSpalt = Array(7, 10) 
'mit dem aktiven Blatt 
'--> wuerde auch sh statt ActiveSheet gehen. 
With ActiveSheet 
 'Blattschutz aufheben 
 .Unprotect 
 'Schleife ueber definierte Spalten 
 For iCnt = 0 To Ubound(strSpalt) 
   'Wenn in Zeile 2 in definierter Spalte "Nein" steht, dann 
   'Hinweis: exakte Schreibweise beachten 
   If .Cells(2, strSpalt(iCnt)) = "Nein" Then 
     'mit der Spalte daneben 
     With .Columns(strSpalt(iCnt) + 1) 
       'Farbe und Schutz setzen 
       .Interior.ColorIndex = 15 
       .Locked = True 
     'Ende mit der Spalte daneben 
     End With 
   'oder Wenn in Zeile 2 in definierter Spalte kein "Nein" steht, dann 
   Else 
     'mit der Spalte daneben 
     With .Columns(strSpalt(iCnt) + 1) 
       'Farbe und Schutz zurueck setzen 
       .Interior.ColorIndex = xlNone 
       .Locked = False 
     'Ende mit der Spalte daneben 
     End With 
   'Ende Wenn in Zeile 2 in definierter Spalte "Nein" steht, dann 
   End If 
 'Ende Schleife ueber definierte Spalten 
 Next 
 'Blattschutz setzen 
 .Protect 
'Ende mit dem aktiven Blatt 
End With 
End Sub