Code plage de cellules en couleur

Bonjour le forum,

Dans le code suivant destiné à colorier des plages de cellules:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Target.Column = 6 Then

If IsNumeric(Target.Value) Then

If Target.Value >= 1 And Target.Value <= 54 Then

Cells(Target.Row, 1).Resize(Target.Value, 11).Interior.ColorIndex = Target.Value + 2

End If

End If

End If

End Sub

Je souhaiterais ajouter une instruction de façon à ce que lorsque on efface la valeur de la cellule 11 le coloriage s’efface également.

Merci d'avance.

Bonjour Largoj, bonjour le forum,

largoj a écrit :

Je souhaiterais ajouter une instruction de façon à ce que lorsque on efface la valeur de la cellule 11 le coloriage s’efface également.

Si tu veux parler de la Colonne 11, essaie comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 6 Then
    If IsNumeric(Target.Value) Then
        If Target.Value >= 1 And Target.Value <= 54 Then
            Cells(Target.Row, 1).Resize(Target.Value, 11).Interior.ColorIndex = Target.Value + 2
        End If
    End If
ElseIf Target.Column = 11 Then
    If Target.Value = "" Then Cells(Target.Row, 1).Resize(Cells(Target.Row, 6).Value, 11).Interior.ColorIndex = xlNone
End If
End Sub

Attention ! Ne fonctionne que si tu effaces la cellule de la colonne 11 sur la même ligne que la valeur éditée en colonne 6...

Merci Thau Thème pour ta réponse rapide. J'ai malheureusement fait une erreur de saisie. Je veux en fait effacer les cellules en couleur quand j'efface les valeurs de la colonne 6. Désolé de t'avoir fait travailler pour rien !!

Cordialement, largoj

Re,

Dans ce cas essaie comme ça :

Private V As Byte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
V = ActiveCell.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 6 Then
    If IsNumeric(Target.Value) Then
        If Target.Value >= 1 And Target.Value <= 54 Then Cells(Target.Row, 1).Resize(Target.Value, 11).Interior.ColorIndex = Target.Value + 2
    End If
    If Target.Value = "" Then Cells(Target.Row, 1).Resize(V, 11).Interior.ColorIndex = xlNone
End If
End Sub

L'utilisation de l'événement SelectionChange et de la variable privée V, permet de stocker la valeur avant l'effacement...

Je reviens vers toi Thau Théme car j'ai un nouveau problème.

Lorsque je copie le code que tu m'as envoyé sur une page vierge cela fonctionne très bien. Mais quand je le copie à la suite d'un autre code existant, j'ai un message d'erreur : ERREUR DE COMPILATION NOM AMBIGU DETECTE : WORK SHEET CHANGE

Ci joint les 2 codes, je pense qu'il y a incompatibilité entre les 2.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Target, Columns("n")) Is Nothing Then

If Target.Count > 1 Or Target.Row < 4 Then Exit Sub 'à partir ligne 4

If Target = "" Then 'si efface "N"

Target.Offset(0, 3).ClearContents 'efface date

Else 'sinon

Target.Offset(0, 3) = Now 'date décaler de 3 colonnes

End Sub

Private V As Byte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

V = ActiveCell.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count > 1 Then Exit Sub

If Target.Column = 6 Then

If IsNumeric(Target.Value) Then

If Target.Value >= 1 And Target.Value <= 54 Then Cells(Target.Row, 1).Resize(Target.Value, 11).Interior.ColorIndex = Target.Value + 2

End If

If Target.Value = "" Then Cells(Target.Row, 1).Resize(V, 11).Interior.ColorIndex = xlNone

End If

End Sub

Peux tu y jeter un œil ?

Merci d'avance

Cordialement, largoj

Re,

Il n'y a pas "incompatibilité" entre les deux. Mais Excel ne tolère qu'un seul événement identique (Change ou autre) par onglet !... Il faut donc se débrouiller pour tout mettre dans le même code. Je vais voir si j'y arrive mais je suis pas sûr de pouvoir te donner une réponse aujourd'hui...

[Édition]

Peut-être comme ça :

Private V As Variant

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
V = ActiveCell.Value
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Or Target.Row < 4 Then Exit Sub 'à partir ligne 4
If Target.Column = 14 Then
    If Target = "" Then 'si efface "N"
        Target.Offset(0, 3).ClearContents 'efface date
    Else 'sinon
        Target.Offset(0, 3) = Now 'date décaler de 3 colonnes
    End If
End If
If Target.Column = 6 Then
    If IsNumeric(Target.Value) Then
        If Target.Value >= 1 And Target.Value <= 54 Then Cells(Target.Row, 1).Resize(Target.Value, 11).Interior.ColorIndex = Target.Value + 2
    End If
    If Target.Value = "" Then Cells(Target.Row, 1).Resize(V, 11).Interior.ColorIndex = xlNone
End If
End Sub

Re,RE..

OK merci. Désolé pour le boulot supplémentaire...

Re,

J'ai édité mon post précédent avec une proposition...

Cette fois tout fonctionne parfaitement. Merci infiniment encore une fois.

A+ sur le forum. Cordialement, lrgoj

Bonjour à tous,

Svp j'ai besoin d'aide sur une fonction avec mise en forme conditionnelle, je m'explique:

Pouvoir modifier la couleur d'une case en fonction du résultat d'une autre, dans mon fichier si la case F11 correspond à "r" ou "a" ou b" ou "c" la case I11 prend la couleur rouge, si la valeur de F11 est "v" elle reste en gris.

Fichier ci-joint

Je vous remercie par avance.