Cellen blokkeren

[Fitz Chevalric]

Is het mogelijk om bv. als er in één bepaalde cel een waarde staat een aantal andere cellen te blokkeren?

Bijvoorbeeld:

In cel G1 wordt er een naam getypt, cellen A1, B1, D1 en E1 moeten geblokkeerd worden zodat er niets meer kan worden aangepast. Wordt er iets in cel G2 getypt dan moet A2, B2, D2 en E2 geblokkeerd worden. Enz..

Alvast bedankt voor de hulp!

 

[Demeter]

Bekijk dit voorbeeld eens.
Alleen de 5 gele cellen hebben een blokkatie als het blad beveiligd wordt.

Met code:

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("G1")) Is Nothing Then
        If Target.Value <> "" Then
            Sheets("Blad1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Else
            Sheets("Blad1").Unprotect
        End If
    End If
    
End Sub

 

[Fitz Chevalric]

Bedankt, hier ga ik al mee kunnen verder doen.

Is er ook een mogelijkheid om in de code de boodschap die wordt weergegeven bij het proberen aanpassen van een beveilidge cel, te veranderen?

 

[Demeter]

Je kan ook je beveiliging zo instellen dat je de cellen niet kan selecteren.

Probeer dit anders een (je andere code laten staan):

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Not Intersect(Target, Range("A2:E2")) Is Nothing Then
        If Sheets("Blad1").Protect = True Then
            MsgBox "Cel is beveiligd, maak eerst cel G1 leeg!!!!"
        End If
    End If
    
End Sub

Zit wel een bug in, als je de cellen selecteerd en er is nog geen data ingevoerd doet hij het ook nog. Kom hier nog op terug, maar wilde het je nog niet onthouden, kan je zelf ook verder.

 

[Demeter]

Bekijk deze eens, code iets aangepast.

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("G2")) Is Nothing Then
        If Target.Value <> "" Then
            Sheets("Blad1").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Else
            Sheets("Blad1").Unprotect
        End If
    End If
    
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Not Intersect(Target, Range("A2:E2")) Is Nothing Then
        If Sheets("Blad1").Range("G2") <> "" Then
            MsgBox "Cel is beveiligd, maak eerst cel G2 leeg!!!!"
        End If
    End If
    
End Sub