Colorer des cellules si checkbox activée

Bonjour à tous,

Je suis confronté à un nouveau problème... Est-il possible de colorer (et non pas masquer, j'ai un autre tableau au dessus de celui là dans le fichier original !) les cellules D3 à G3, D4 à G4 et D5 à G5 lorsque la checkbox est cochée et de remettre le fichier comme l'original lorsque la checkbox est décochée ???

Merci beaucoup de vos lumières,

Bonne journée,

Amicalement

Bonjour,

A adapter avec les couleurs souhaitées (et à modifier un peu si tu veux une couleur différente par ligne) :

Private Sub CheckBox1_Click()

If CheckBox1.Value = True Then
    Range("D3:G5").Interior.ColorIndex = 3
Else
    Range("D3:G5").Interior.ColorIndex = 2
End If

End Sub

Cordialement,

oui c cela

Merci à vous, zirak, mouss !! En utilisant l'enregistreur de macro, j'arrive à ce que je veux, mais mon code est "compliqué" (selection...).. Une bonne âme pourrait-elle m'aider à le simplifier et le rendre plus "propre" ???

If CheckBox1.Value = True Then
    Range("D10:I12").Select
    With Selection.Font
        .Name = "MS Reference Sans Serif"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 24
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 24
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Else
    Range("D10:I12").Select
    With Selection.Font
        .Name = "MS Reference Sans Serif"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
    Range("D11:I12").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 29
    End With
End If

End Sub

Bon après midi,

Amicalement

re,

Tu peux déjà en enlever une partie et ne laisser que cela :

Private Sub CheckBox1_Click()

If CheckBox1.Value = True Then
    Range("D10:I12").Select
    With Selection.Font
        .ColorIndex = 24
    End With
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    With Selection.Interior
        .ColorIndex = 24
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With
Else
    Range("D10:I12").Select
    With Selection.Font
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Interior
        .ColorIndex = 2
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
    End With

    Range("D11:I12").Select
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = 29
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = 29
    End With
End If

End Sub

Après c'est peut-être possible d'optimiser plus, mais il faudrait tester bloc par bloc pour voir, et je n'ai pas trop le temps ^^

Cordialement,

Impeccable !! Merci beaucoup Zirak !!

Bonne fin de journée,

Amicalement