Autres Colorer une cellule en un clic

[baguihome]

Bonjour à tous,

J'ai crée un fichier excel dans lequel je souhaiterai rendre une colonne interactive : pour chacune des cellules de cette colonne, un clic = colore la cellule en rouge ; un deuxième clic dans cette même cellule = colore en vert (passe du rouge au vert) ; un troisième clic = retour à la couleur initiale de la cellule (passe du vert à la couleur initiale de la cellule).
J'ai trouvé un code qui fonctionne assez bien (je le mets en fin de post). Reste quelques petits problèmes : le 3ème clic colore la cellule en blanc alors que les lignes de mon fichier sont alternativement blanches et grises. C'est pour ça que je souhaiterais pouvoir ramener la cellule à sa couleur d'origine au 3ème clic. Deuxième petit problème, quand j'essaie de protéger le reste du fichier (toutes les cellules sauf celle de la colonne colorable) la macro ne fonctionne plus. 3ème problème, le code que j'ai trouvé s'applique sur 2 colonnes, quelles modifications apporter au code pour qu'il ne concerne plus que la colonne D. Enfin, le code suivant fonctionne avec un double clic, je souhaiterai qu'il fonctionne avec un clic gauche.

Est-ce faisable de faire ce que je souhaite ?

Merci d'avance pour votre aide et désolé pour mon ignorance…

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
If Not Intersect(Target, Range("D:E")) Is Nothing Then
couleurs = Array(RGB(255, 0, 0), RGB(13, 241, 105), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 3)
Cancel = True
End If
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End Sub

 

[bsalv]

bonjour,
si le couleur gris alternate vient d'un tableau structuré ou d'un MFC ?

 

[baguihome]

Non, pas de MFC, j'ai juste coloré une ligne sur 2 en gris

 

[bsalv]

re,

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

     Dim Couleurs(): Couleurs = Array(-1, RGB(255, 0, 0), RGB(13, 241, 105))

     If Intersect(Target, Range("D:E")) Is Nothing Then Exit Sub

     With Target
          Me.Unprotect
          ic = .Interior.color
          i = Application.Match(ic, Couleurs, 0)
          If Not IsNumeric(i) Then
               i = 1     'on prendra "rouge"
               On Error Resume Next
               s = "?": s = .Comment.Text     'y-a-t-il déjà du commentaire dans la cellule, sinon s sera "?"
               On Error GoTo 0
               If s = "?" Then .AddComment: .Comment.Visible = False     'créer commentaire invisible
               .Comment.Text Text:=CStr(ic)     'ajouter numéro du couleur dans le commentaire
          End If

          Select Case (i Mod 3)
               Case 1, 2: Target.Interior.color = Couleurs(i Mod 3)     'seulement votre rouge et vert
               Case Else
                    On Error Resume Next
                    .Interior.color = xlNone     'aucun couleur
                    .Interior.color = .Comment.Text     'essayer à mettre la couleur di commentaire
                    On Error GoTo 0
          End Select
          Cancel = True
          Me.Protect
     End With

End Sub

 

[baguihome]

Bonjour Bsalv,

Merci beaucoup pour ton code, il fonctionne à merveille !! Si je comprend bien tu as utilisé un commentaire comportant le code couleur initial de la cellule ? Juste une petite question, peut-on transformer le double clic en simple clic ?

En tout cas merci beaucoup, c'est top !!

 

[bsalv]

bonjour bagouihome,

Oui, le couleur initial est dans le commentaire, c'était le plus facile à réaliser, mais il y a d'autres méthodes, si vous utilisez déjà les commentaires ... .

Si vous changez le nom de la macro "Worksheet_BeforeDoubleClick" en "Worksheet_BeforeRightClick" cela fonctionnera avec le bouton droit.

 

[baguihome]

Et avec le bouton gauche, est-ce possible ?

 

[baguihome]

J'ai essayé de remplacer "Worksheet_BeforeDoubleClick" par "Worksheet_SelectionChange" mais ça ne fonctionne pas. Ca ne fonctionne pas non plus avec "Worksheet_BeforeRightClick". J'ai l'impression que c'est la protection de la feuille qui pose probleme...?

 

[bsalv]

voir PJ, la feuille est protégée, le commentaire est maintenant d'une taille minimale.

 

[baguihome]

Super, ça fonctionne !

Merci beaucoup pour ton aide !

 

[bsalv]

Merci et il n'y a pas un event pour le bouton gauche, sorry.

 

[baguihome]

ah ok. Mais en fait bouton droit c'est très bien !

 

[baguihome]

Petite question, Si je veux étendre la macro à d'autres colonnes, comment dois-je coder ? Par exemple si la coloration des cases doit s'appliquer sur les colonnes C à G (CDEFG) et J à N (JKLMN) ?

 

[bsalv]

bonjour,
alors la ligne de "intersect" changera

If Intersect(Target, Range("C:G,J:N")) Is Nothing Then Exit Sub

 

[baguihome]

Parfait ! Encore merci !