XL 2021 Coloriser une cellule avec un click d'une colonne

JMC

XLDnaute Junior
Bonjour à tous,
Me revoilà avec mon tableau pour l'association.
Dans la colonne "E" (virement) je voudrais coloriser automatiquement une cellule (soit la ligne 6 ou une autre qui irait jusqu'à la ligne 25) et cela lorsque je clique sur la cellule concernée.
Exemple, si un adhérent veut payer sa cotisation par virement, au lieu de coloriser manuellement sa ligne avec le pot de peinture de l'accueil, qu'elle se colorise automatiquement, avec une couleur que j'aurai choisi, lorsque je clique dans cette colonne seulement et sur sa ligne. Et cela que pour les "produits" et pour les autres mois de l'année bien sûr
Je vous ai mis en pièce jointe un exemple pour mieux comprendre.
Merci pour votre aide

Cordialement
 

Pièces jointes

  • Exemple dossier.xlsm
    12.6 KB · Affichages: 6
Solution
Bonjour JMC, wDog66, le forum,

Mettez dans ThisWorkbook :
VB:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.Color = RGB(189, 215, 238)
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub
Double-clic en colonne E pour colorer, clic droit pour effacer la couleur.

A+

wDog66

XLDnaute Occasionnel
Bonjour,

Il faut mettre un code dans ThisWorkbook
1732071847735.png


Exemple
VB:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  ' On sort si en dehors des clous
  If Target.Row < 6 Or Target.Row > 25 Then Exit Sub
  ' Clic dans la colonne J
  If Not Intersect(Range("J6:O25"), Target) Is Nothing Then
    Target.Interior.ColorIndex = 6
  End If
End Sub

A+
 

job75

XLDnaute Barbatruc
Bonjour JMC, wDog66, le forum,

Mettez dans ThisWorkbook :
VB:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.Color = RGB(189, 215, 238)
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub
Double-clic en colonne E pour colorer, clic droit pour effacer la couleur.

A+
 

Pièces jointes

  • Exemple dossier.xlsm
    18.7 KB · Affichages: 3

JMC

XLDnaute Junior
Bonjour wDog66 et bonjour job75,
Merci à vous deux pour votre aide.
La solution de job75 est impeccable.
Désolé wDog66 pour le travail que tu as fourni, mais j'ai beau cliquer sur une des cellules de la colonne "E", rien ne se passe. J'ai bien copié/collé ta VBA et bien mis dans ThisWorkbook.
Encore merci pour vos efforts à venir en aide aux amateurs comme moi? J'avais beau regarder sur le net, et essayer avec chatGPT, rien ne fonctionnait.
A une autre fois si j'ai besoin d'aide.
Cordialement

 

JMC

XLDnaute Junior
Bonjour JMC, wDog66, le forum,

Mettez dans ThisWorkbook :
VB:
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.Color = RGB(189, 215, 238)
End Sub

Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Left(UCase(Sh.[G1]), 7) <> "PRODUIT" Or Target.Row < 6 Or Target.Column <> 5 Then Exit Sub
Cancel = True
Target.Interior.ColorIndex = xlNone
End Sub
Double-clic en colonne E pour colorer, clic droit pour effacer la couleur.

A+
Excuse du dérangement. Je viens de coller ta formule, là où il le faut. Tout fonctionne bien, sauf que pour le mois de novembre (et que ce mois ci tous les autres sont ok) rien ne se passe....
 

Discussions similaires

Réponses
5
Affichages
285

Statistiques des forums

Discussions
315 109
Messages
2 116 300
Membres
112 716
dernier inscrit
jean1234