XL 2019 Verrouiller plusieurs cellules avec condition

[pat66]

Bonjour le forum,

Je souhaiterai verrouiller les cellules : Y47,Y49, Y54, si Y71 = "Oui", et les débloquer si Y71 = "Non"
mais j'ai déjà les conditions suivantes, pourriez vous m'aider à intégrer cette action dans le code suivant :

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ("toto")
            If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [Y71]) Is Nothing Then
        If Target = "Non" Then
        ActiveSheet.Shapes("Ellipse 15").Visible = True
        ActiveSheet.Shapes("Rectangle : coins arrondis 3").Visible = True
        ActiveSheet.Shapes("Rectangle : coins arrondis 13").Visible = True
        ActiveSheet.Shapes("Rectangle : coins arrondis 14").Visible = True
        ActiveSheet.Shapes("Rectangle : coins arrondis 16").Visible = True
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 16").Visible = True
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 17").Visible = True
Else
        ActiveSheet.Shapes("Ellipse 15").Visible = False
        ActiveSheet.Shapes("Rectangle : coins arrondis 3").Visible = False
        ActiveSheet.Shapes("Rectangle : coins arrondis 13").Visible = False
        ActiveSheet.Shapes("Rectangle : coins arrondis 14").Visible = False
        ActiveSheet.Shapes("Rectangle : coins arrondis 16").Visible = False
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 16").Visible = False
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 17").Visible = False
        ActiveSheet.Range("Y74").Value = "0"
End If
End If
ActiveSheet.protect ("toto")
end sub

merci d'avance

 

[fanch55]

Bonjour,
Essayez ce code à main levée ( non testé ) :

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ("toto")
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.[Y71]) Is Nothing Then
        Me.Shapes("Ellipse 15").Visible = Target = "Non"
        Me.Shapes("Rectangle : coins arrondis 3").Visible = Target = "Non"
        Me.Shapes("Rectangle : coins arrondis 13").Visible = Target = "Non"
        Me.Shapes("Rectangle : coins arrondis 14").Visible = Target = "Non"
        Me.Shapes("Rectangle : coins arrondis 16").Visible = Target = "Non"
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 16").Visible = Target = "Non"
        Worksheets("Bilan").Shapes("Rectangle : coins arrondis 17").Visible = Target = "Non"
        If Target = "Oui" Then Me.[Y74].Value = "0"
        Me.[Y47,Y49,Y54].Locked = Target = "Oui"
    End If
ActiveSheet.Protect ("toto")
End Sub

 

[pat66]

Bonjour
et merci de votre aide,

J'ai un beug avec erreur 1004, impossible de définir la propriété locked de la classe range
Me.[Y47,Y49,Y54].Locked = Target = "Oui"

cdt

 

[fanch55]

Ok, c'est dû à la re-protection de la feuille quand Y74 passe à 0.
Correction:

Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect ("toto")
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, Me.[Y71]) Is Nothing Then
        Application.EnableEvents = False
            Me.Shapes("Ellipse 15").Visible = Target = "Non"
            Me.Shapes("Rectangle : coins arrondis 3").Visible = Target = "Non"
            Me.Shapes("Rectangle : coins arrondis 13").Visible = Target = "Non"
            Me.Shapes("Rectangle : coins arrondis 14").Visible = Target = "Non"
            Me.Shapes("Rectangle : coins arrondis 16").Visible = Target = "Non"
            Worksheets("Bilan").Shapes("Rectangle : coins arrondis 16").Visible = Target = "Non"
            Worksheets("Bilan").Shapes("Rectangle : coins arrondis 17").Visible = Target = "Non"
            If Target = "Oui" Then Me.[Y74].Value = "0"
            Me.[Y47,Y49,Y54].Locked = Target = "Oui"
        Application.EnableEvents = True
    End If
ActiveSheet.Protect ("toto")
End Sub