Changer couleur de cellule par un clic
Bonjour je cherche la solution pour changer la couleur d'une case juste en cliquant dessus ceci avec 4 couleurs possible.
Je m'explique: par exemple en cliquant sur la case B2 la couleur de fond de celle-ci doit changer au premier clic du vert au rouge au second clic du rouge au bleu au troisième du bleu au blanc puis du blanc retour au rouge... ceci sans changer le texte présent dans la case. pour le moment je sèche...
Merci a tous ceux qui pourrons m'aider.
Bonsoir,
Autre solution :
cordialement
ps : banzai, sais tu s'il existe un moyen pour gérer le clic simple, et non le double clic?
cordialement
Bonsoir.
Par double-clique peut-être. Ici, les changements de couleurs se font uniquement sur la colonne A
La couleur -4142 correspond en réalité à "aucun remplissage". Si tu as du blanc, modifie la valeur "-4142" par "2"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("a:A")) Is Nothing Then
coul = Target.Interior.ColorIndex
Select Case coul
Case 5
Target.Interior.ColorIndex = -4142
Case 4
Target.Interior.ColorIndex = 3
Case 3
Target.Interior.ColorIndex = 5
Case -4142
Target.Interior.ColorIndex = 4
Case Else
MsgBox "Cette couleur n'est pas reconnue."
End Select
End If
End SubEDIT: Oups, désolé, j'avais laissé l'ordi allumé et pas vu vos codes.
pass-pass a écrit :Bonsoir.
Par double-clique peut-être. Ici, les changements de couleurs se font uniquement sur la colonne A
La couleur -4142 correspond en réalité à "aucun remplissage". Si tu as du blanc, modifie la valeur "-4142" par "2"
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Application.Intersect(Target, Range("a:A")) Is Nothing Then coul = Target.Interior.ColorIndex Select Case coul Case 5 Target.Interior.ColorIndex = -4142 Case 4 Target.Interior.ColorIndex = 3 Case 3 Target.Interior.ColorIndex = 5 Case -4142 Target.Interior.ColorIndex = 4 Case Else MsgBox "Cette couleur n'est pas reconnue." End Select End If End SubEDIT: Oups, désolé, j'avais laissé l'ordi allumé et pas vu vos codes.
-- 10 Avr 2011, 12:58 --
ketamacanna a écrit :Bonsoir,
Autre solution :
cordialement
ps : banzai, sais tu s'il existe un moyen pour gérer le clic simple, et non le double clic?
cordialement
bonsoir
merci pour le tableau mais j aimerais changer les couleurs, actuellement ils y a rouge, bleu et blanc et j aimerais changer le bleu par le gris comment puis-je faire
merci d avance
[quote="ketamacanna"]Bonsoir,
Autre solution :
cordialement
Bonjour.
Remplace la ligne:
Target.Interior.ColorIndex = 5
par celle-ci
Target.Interior.ColorIndex = 16j ai la version 2010, peut êtres que le code change car la formule que j ai
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
couleurs = Array(RGB(255, 0, 0), RGB(0, 0, 255), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 3)
Cancel = True
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End Sub
je l ai trouver ds developper\visualiser le code
Bonjour,
Dans le code, remplace
couleurs = Array(RGB(255, 0, 0), RGB(0, 0, 255), RGB(255, 255, 255))par
couleurs = Array(RGB(255, 0, 0), RGB(190, 190, 190), RGB(255, 255, 255))cordialement
bonjour ketamacanna
merci beaucoup pour la réponse, sa marche nickel
cordialement
Bonjour à tous,
je me permets de relancer ce post pour d'une part, vous remercier pour les très bonnes infos sur le sujet et d'autre part, vous posez quelques questions en conséquences. Je suis débutant en VBA donc vous m'excuserez pour les approximations.
Je souhaite tout simplement définir plusieurs zones sur un même onglet me permettant de coloriser une cellule avec divers choix. Par exemple, en colonne A, après un clic, obtenir une couleur et revenir au blanc avec un 2e clic avec ce code :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("a:A")) Is Nothing Then Exit Sub
Dim couleurs()
couleurs = Array(RGB(255, 153, 0), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 3)
Cancel = True
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End Sub
Mais en plus, pouvoir en colonne AL, par exemple, réaliser la même opération avec 3-4 couleurs.
En vous remerciant pour vos conseils !
Pierre
Bonjour
A tester
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
If Not Intersect(Target, Range("A:A")) Is Nothing Then
couleurs = Array(RGB(255, 153, 0), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 2)
Cancel = True
ElseIf Not Intersect(Target, Columns("AL")) Is Nothing Then
couleurs = Array(RGB(255, 153, 0), RGB(0, 0, 255), RGB(0, 255, 0), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 4)
Cancel = True
End If
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End SubBonjour Banzai64,
Parfait !
Le code fonctionne à merveille, je comprends mieux là je coinçais....
Merci beaucoup pour le coup de main !
Pierre
Bonjour
Je me permet de relancer la discussion. J'ai juste une question :
- > Vis à vis du fichier ''autre_solu.xls'' posté par un internaute en page une, quel est le code si je veux rajouter d'autres couleurs, plus de 3 ? Par exemple moi ce serait 7 couleurs.
- > J'ai essayé de ragouter des codages RGB mais sans succès
Cordialement
Salut Thibault,
Trois manières en utilisant COLORINDEX :
- une brutale
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Interior.ColorIndex < 0 Then Target.Interior.ColorIndex = 1
Target.Interior.ColorIndex = IIf(Target.Interior.ColorIndex < 55, Target.Interior.ColorIndex + 1, 0)
'
End Sub- une Las Vegas
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Interior.ColorIndex < 0 Then Target.Interior.ColorIndex = 1
Target.Interior.ColorIndex = Int(Rnd * 56) + 1
'
End Sub- une civilisée
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Interior.ColorIndex < 0 Then Target.Interior.ColorIndex = 1
Target.Interior.ColorIndex = IIf(Target.Interior.ColorIndex < 8, Target.Interior.ColorIndex + 1, 1)
'
End SubBon amusement!
A+
Bonjour et merci pour ta réponse rapide
Je comprends pas bien tes méthodes, tu combines un de ces codes au code que j'ai déjà ?
Le problème que j'ai est que dans cette partie du code (que j'ai récupéré sur le premier fichier et qui fonctionne très bien pour 3 couleur) :
couleurs = Array(RGB(255, 0, 0), RGB(0, 0, 255), RGB(255, 255, 255))
Je n'arrive pas à ''l'allonger'' afin de rajouter encore des RGB(x , x , x) pour arriver à 8 couleurs, je pense que le début du code ne le permet pas mais j'arrive pas à comprendre.
Cordialement et merci d'avance
Salut Thibault,
en fait, tu dois appliquer le modulo correspondant au nombre de couleurs.
C'est aussi simple que ça!
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim couleurs()
'
If Target.Count > 1 Then Exit Sub
couleurs = Array(RGB(255, 0, 0), RGB(0, 0, 255), RGB(255, 255, 255), RGB(124, 147, 125), RGB(25, 87, 96), RGB(45, 98, 198), RGB(169, 178, 214))
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 7)
'
End SubAvec plaisir!
A+
Bonjour
Je n'arrive pas à faire fonctionner ton code, une des lignes apparait en jaune quand j'essaye de le débloquer ?
Cdt
Salut Thibault,
envoie-moi TON fichier!
Il y a tellement de causes au moindre problème!
A+