Couleur cellule

Bonjour à tous,

Je reviens vers vous, car je souhaiterai votre aide

J'ai un fichier joint à ma demande, avec une feuille (LISTE)

Est il possible de mettre en couleur, la cellule sélectionnée et de revenir vers la couleur d'origine (BLANC)

en choisissant une autre sélection

Serait il également possible de varier la couleur de la cellule sélectionnée en fonction de la colonne ???

B-D-F-H

Merci par avance de votre aide,

Bien cordialement

Fabien67

Bonjour,

il y a la surveillance événementielle avec Selection_Change des feuilles pour détecter quelle cellule est sélectionnée.

Il y a .interior.color pour définir la couleur intérieur des cellule avec xlNone pour le "sans couleur", et le RGB(x, y, z) avec x, y et z des curseur allant de 0 à 255 pour la variation des couleurs rouges, vertes et bleues.

le .column pour connaître le numéro de colonne

Il faudra mettre en mémoire l'adresse de la dernière cellule cliquée afin de savoir laquelle passer en "sans couleur".

@ bientôt

LouReeD

Bonsoir LouReed

Merci pour votre réponse,

Hélas pour moi, le code VBA, reste dans le domaine de l'inconnu

Je n'y comprend pas grand chose et pour ainsi dire, rien

Vraiment désolé

Cordialement

F67

Voici le code "exemple" à mettre sur la feuille suite à un clic droit sur le nom de l'onglet et avoir sélectionner "afficher le code" :

Option Explicit

Dim Adr As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("B:B, D:D, F:F, H:H")) Is Nothing And Target.CountLarge = 1 Then
        Target.Interior.Color = RGB(Target.Column * 2, Target.Column * 15, Target.Column * 30)
        If Not Adr Is Nothing Then Adr.Interior.Color = xlNone
        Set Adr = Target
    Else
        If Not Adr Is Nothing Then Adr.Interior.Color = xlNone
        Set Adr = Nothing
    End If
End Sub

@ bientôt

LouReeD

Merci LouReed, pour le code

J'ai déja un premier code que voici

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.CountLarge > 1 Then Exit Sub

If Target.Column > 8 Then Exit Sub

If Cells(1, Target.Column).Value <> "" Then

Dim Plage As Range, Trouve As Range, ValCherchée As String

ValCherchée = ActiveSheet.Cells(1, Target.Column)

With Sheets(ValCherchée)

Set Plage = .Range(.ListObjects(1).Name & "[" & ValCherchée & "]")

Set Trouve = Plage.Cells.Find(what:=Target.Value, lookat:=xlWhole)

If Trouve Is Nothing Then MsgBox ("Recherche abandonnée !"): Exit Sub

Range("K1") = Trouve.Offset(, 1)

Range("M1") = Trouve.Offset(, 2)

End With

End If

End Sub

En mettant le code à la suite du premier, j'ai pas mal d'erreurs

Hélas,

Mais je le reconnais ce code !

Mais pas de soucis, ici ou ailleurs c'est la même chose !

Ici c'est bien cela fait vivre le forum !

En clair, vous voulez que la cellule sélectionnée sur la feuille "Liste" se colorise lors de sa sélection, et revienne a son état initial après et que cela soit compatible avec la première partie de code ?

Est-ce bien cela ?

@ bientôt

LouReeD

Voilà le nouveau code :

Dim Adr As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' cellule sélectionnée = vert sinon xlnone
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column > 8 Then Exit Sub
    If Cells(1, Target.Column).Value <> "" Then
        Dim Plage As Range, Trouve As Range, ValCherchée As String
        ValCherchée = ActiveSheet.Cells(1, Target.Column)
        With Sheets(ValCherchée)
            Set Plage = .Range(.ListObjects(1).Name & "[" & ValCherchée & "]")
            Set Trouve = Plage.Cells.Find(what:=Target.Value, lookat:=xlWhole)
            If Trouve Is Nothing Then MsgBox ("Recherche abandonnée !"): Exit Sub
            Range("K1") = Trouve.Offset(, 1)
            Range("M1") = Trouve.Offset(, 2)
        End With
    End If
    If Not Intersect(Target, Range("B:B,D:D,F:F,H:H")) Is Nothing Then
        Target.Interior.Color = RGB(0, 255, 0)
        If Not Adr Is Nothing Then Adr.Interior.Color = xlNone
        Set Adr = Target
    End If
End Sub

Il se peut qu'il y ait une petite erreur d'affichage avec l'ouverture de fichier, mais il suffira de sélectionner la cellule verte afin de recommencer le cycle...

@ bientôt

LouReeD

Bonsoir LouReed,

Effectivement, cela fonctionne,

Mais un petit bémol,

En sauvegardant le fichier, et en revenant sur la feuille (LISTE)

La dernière cellule sélectionnée avant fermeture reste active et il me faut rappuyer sur la cellule, et en sélectionner une autre

Y aurait-il la possibilité de mettre une couleur différente pour chaque colonne ???

Merci pour votre travail, et surtout merci de mettre vos connaissances au service des autres personnes

BRAVO

Je vous aie parlé du petit bémol sur le message du dessus...

Il se peut qu'il y ait une petite erreur d'affichage avec l'ouverture de fichier, mais il suffira de sélectionner la cellule verte afin de recommencer le cycle...

@ bientôt

LouReeD

Bonsoir LouReed

Merci à vous

Bien cordialement

Fabien 67

Bon je commence à l'utiliser de plus en plus !

Je met en mémoire dans une donnée nommée l'adresse de la cellule colorisée. Et hop ! Ca à l'ir de marcher !

Dim Adr As Range
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' cellule sélectionnée = couleur du nom de la colonne
    If Target.CountLarge > 1 Then Exit Sub
    If Target.Column > 8 Then Exit Sub
    If Cells(1, Target.Column).Value <> "" Then
        Dim Plage As Range, Trouve As Range, ValCherchée As String
        ValCherchée = ActiveSheet.Cells(1, Target.Column)
        With Sheets(ValCherchée)
            Set Plage = .Range(.ListObjects(1).Name & "[" & ValCherchée & "]")
            Set Trouve = Plage.Cells.Find(what:=Target.Value, lookat:=xlWhole)
            If Trouve Is Nothing Then MsgBox ("Recherche abandonnée !"): Exit Sub
            Range("K1") = Trouve.Offset(, 1)
            Range("M1") = Trouve.Offset(, 2)
        End With
    End If
    If Not Intersect(Target, Range("B:B,D:D,F:F,H:H")) Is Nothing Then
        Set Adr = Range([Der_Cel])
        Target.Interior.Color = Cells(1, Target.Column).Interior.Color
        If Not Adr Is Nothing Then Adr.Interior.Color = xlNone
        ThisWorkbook.Names("Der_Cel").Value = Target.Address
    End If
End Sub

Ce code ne vaut que s'il y a a un nom "Der_Cel" de créer dans le classeur.

@ bientôt

LouReeD

J'oubliais, pour les couleurs différentes j'ai repris celle d'entête de colonne, comme cela le choix est rapide, il n'y a pas à toucher au code il suffit de modifier directement la couleur d'entête de la colonne.

@ bientôt

LouReeD

Désolé, j'ai une erreur:

Set Adr = Range([Der_Cel])

En effet au premier tour la valeur du nom n'est pas son adresse mais sa valeur, du coup vous prenez le pointeur en face de la ligne en jaune du code, vous le descendez d'une ligne et vous faites [F5] comme cela le reste du code va inscrire une donnée "adresse" dans le nom et il ne devrait plus y avoir de problème.

Avec le fichier du site :

@ bientôt

LouReeD

BRAVO

Merci pour toutes ces notes !

@ bientôt (ici)

LouReeD