Changer couleur cellule active

Salut forum.

Jai une plage de cellule B5:B11

j'aimerais faire un code qui va faire changer de couleur a la cellule sélectionnée et la ramener a la couleur initiale si on désélectionne.

Merci

Bonjour,

Dommage que tu n'aies pas joint un petit fichier test ...

Donc ... à l'aveugle ...tu peux essayer la macro suivante:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B5:B11")) Is Nothing Then Range("B5:B11").Interior.Color = xlNone: Exit Sub
Range("B5:B11").Interior.Color = xlNone
Target.Interior.Color = vbYellow
End Sub

Bonjour,

Bonjour James007,

Une autre !?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const RNG As String = "B5:B11"
    If Not Intersect(Target, Me.Range(RNG)) Is Nothing And Target.CountLarge = 1 Then
        Me.Range(RNG).Interior.Color = xlNone
        Target.Interior.Color = vbRed
    End If
End Sub

Salut Jean-Eric,

La requête n'est pas très précise ... et pas de fichier test ...

Du coup, je me demande s'il ne faudrait pas gérer les différentes couleurs qui existeraient avant la sélection ...

pour les retrouver dès que la cellule active est modifiée ...

A suivre ...

Re,

KTM va devoir préciser sa question.

Cdlt.

James007 a écrit :

Bonjour,

Dommage que tu n'aies pas joint un petit fichier test ...

Donc ... à l'aveugle ...tu peux essayer la macro suivante:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("B5:B11")) Is Nothing Then Range("B5:B11").Interior.Color = xlNone: Exit Sub
Range("B5:B11").Interior.Color = xlNone
Target.Interior.Color = vbYellow
End Sub

super

J'ai adapté et ça fonctionne

Merci

Jean-Eric a écrit :

Bonjour,

Bonjour James007,

Une autre !?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const RNG As String = "B5:B11"
    If Not Intersect(Target, Me.Range(RNG)) Is Nothing And Target.CountLarge = 1 Then
        Me.Range(RNG).Interior.Color = xlNone
        Target.Interior.Color = vbRed
    End If
End Sub

Merci Beaucoup

ça me convient

Bonjour,

une proposition qui met une MFC.

Le format d'origine est conservé, plus rien à restaurer :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim fc     As FormatCondition
    For Each fc In Cells.FormatConditions
        If fc.Formula1 = "=VRAI" Then fc.Delete
    Next fc
    With Target
        .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

eric

eriiic a écrit :

Bonjour,

une proposition qui met une MFC.

Le format d'origine est conservé, plus rien à restaurer :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim fc     As FormatCondition
    For Each fc In Cells.FormatConditions
        If fc.Formula1 = "=VRAI" Then fc.Delete
    Next fc
    With Target
        .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 65535
            .TintAndShade = 0
        End With
        .FormatConditions(1).StopIfTrue = False
    End With
End Sub

eric

intéressant!!!

Mais comment limiter a ma seule plage B5:B11 ?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim fc As FormatCondition
    For Each fc In Cells.FormatConditions
        If fc.Formula1 = "=VRAI" Then fc.Delete
    Next fc
    If Not Intersect(Target, [B5:B11]) Is Nothing Then
        With Target
            .FormatConditions.Add Type:=xlExpression, Formula1:="=VRAI"
            Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
            End With
            .FormatConditions(1).StopIfTrue = False
        End With
    End If
End Sub

si tu veux conserver le surlignement lors d'une sélection externe à B5:B11, remonte la ligne If Not Intersect au début du code.

eric

Bonjour,

Différents exemples en PJ

Boisgontier

KTM a écrit :

super

J'ai adapté et ça fonctionne

Merci

Merci pour tes remerciements

Boisgontierjacques a écrit :

Bonjour,

Différents exemples en PJ

Boisgontier

Merci