Mise en forme conditionnelle en VBA

Bonjour à tous,

je prépare un document sous excel et pour simplifier la procédure de mise en forme conditionnelle, car il y aura beaucoup de lignes, je souhaite faire les mises en forme conditionnelles en VBA.

Mon idée est la suivante (je l'ai fait dans le fichier joint pour commencer) :

lorsque l'on complète une case (D7 ou D8 ou D9 ou D10), cela colore les case D13 à 16, D19 à 22, D25 à 28, D31 à 34, D37 à 40.

Mais si par la suite, on met une valeur en D14, la série D13 à D16 redevient blanche. Comme sur l'exemple.

Par contre, je n'ai pas encore mis la suite, c'est à dire, si l'on met uniquement une valeur en D37 par exemple, il faut que les séries de case plus haut soit toutes en couleurs.

Quelqu'un à une idée ? je ne sais pas si je suis assez clair

Bonjour,

Pas sûr de bien tout comprendre mais testes pour voir !

A mettre dans le module de la feuille :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column <> 4 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Select Case Target.Row

        Case 7 To 10: If Target.Value <> "" Then Range("D13:D16, D19:D22, D25:D28, D31:D34, D37:D40").Interior.ColorIndex = 44
        Case 13 To 16: If Target.Value <> "" Then Range("D13:D16").Interior.ColorIndex = 0
        Case 19 To 22: If Target.Value <> "" Then Range("D19:D22").Interior.ColorIndex = 0
        Case 25 To 28: If Target.Value <> "" Then Range("D25:D28").Interior.ColorIndex = 0
        Case 31 To 34: If Target.Value <> "" Then Range("D31:D34").Interior.ColorIndex = 0

    End Select

End Sub

J'ai complété le code :

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column <> 4 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Select Case Target.Row

        Case 7 To 10: If Target.Value <> "" Then Range("D13:D16, D19:D22, D25:D28, D31:D34, D37:D40").Interior.ColorIndex = 44
        Case 13 To 16: If Target.Value <> "" Then Range("D13:D16").Interior.ColorIndex = 0
        Case 19 To 22: If Target.Value <> "" Then Range("D19:D22").Interior.ColorIndex = 0
        Case 25 To 28: If Target.Value <> "" Then Range("D25:D28").Interior.ColorIndex = 0
        Case 31 To 34: If Target.Value <> "" Then Range("D31:D34").Interior.ColorIndex = 0

    End Select

     Select Case Target.Row

        Case 13 To 16: If Target.Value <> "" Then Range("D7:D10, D19:D22, D25:D28, D31:D34, D37:D40").Interior.ColorIndex = 44
        Case 7 To 10: If Target.Value <> "" Then Range("D7:D10").Interior.ColorIndex = 0
        Case 19 To 22: If Target.Value <> "" Then Range("D19:D22").Interior.ColorIndex = 0
        Case 25 To 28: If Target.Value <> "" Then Range("D25:D28").Interior.ColorIndex = 0
        Case 31 To 34: If Target.Value <> "" Then Range("D31:D34").Interior.ColorIndex = 0

    End Select

End Sub

Cela fonctionne partiellement, car si je supprime une valeur, la couleur reste quand même. De plus, à l'inverse, si je mets une valeur dans la cellule 7 par exemple, cela colore les autres OK, ensuite je mets une valeur en 13 et la couleur disparaît de 13 à 16 OK, mais si je re-enlève la valeur en 13, la couleur ne se remet pas

Et en rajouter le code que j'ai mis en fait cela me créer une erreur. Car cela colore à nouveau les lignes déjà remplies....

Comme ceci alors ?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tbl(1 To 6) As String
    Dim T
    Dim I As Integer

    If Target.Column <> 4 Then Exit Sub
    If Target.Count > 1 Then Exit Sub

    Tbl(1) = "D13:D16,D19:D22,D25:D28,D31:D34,D37:D40"
    Tbl(2) = "D13:D16"
    Tbl(3) = "D19:D22"
    Tbl(4) = "D25:D28"
    Tbl(5) = "D31:D34"
    Tbl(6) = "D37:D40"

    Select Case Target.Row

        Case 7 To 10
            If Target.Value <> "" Then

                T = Split(Tbl(1), ",")

                For I = 0 To UBound(T)
                    If Valeur(Range(T(I))) Then Range(T(I)).Interior.ColorIndex = 0 Else Range(T(I)).Interior.ColorIndex = 44
                Next I

            Else

                Range(Tbl(1)).Interior.ColorIndex = 0

            End If

        Case 13 To 16: If Target.Value <> "" Then Range(Tbl(2)).Interior.ColorIndex = 0 Else Range(Tbl(2)).Interior.ColorIndex = 44
        Case 19 To 22: If Target.Value <> "" Then Range(Tbl(3)).Interior.ColorIndex = 0 Else Range(Tbl(3)).Interior.ColorIndex = 44
        Case 25 To 28: If Target.Value <> "" Then Range(Tbl(4)).Interior.ColorIndex = 0 Else Range(Tbl(4)).Interior.ColorIndex = 44
        Case 31 To 34: If Target.Value <> "" Then Range(Tbl(5)).Interior.ColorIndex = 0 Else Range(Tbl(5)).Interior.ColorIndex = 44
        Case 37 To 40: If Target.Value <> "" Then Range(Tbl(6)).Interior.ColorIndex = 0 Else Range(Tbl(6)).Interior.ColorIndex = 44

    End Select

End Sub

Function Valeur(Plage As Range) As Boolean

    Dim Cel As Range

    For Each Cel In Plage

        If Cel.Value <> "" Then

            Valeur = True
            Exit Function

        End If

    Next Cel

End Function

C'est parfait merci beaucoup

Bonjour,

Content de t'avoir aidé