Macro colorer cellule

Résolu/Fermé

Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017 - 27 déc. 2016 à 14:12
Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017 - 30 déc. 2016 à 15:17

Bonjour à tous,
J'ai une colonne L où se trouve plusieurs nom de personnes
Je voudrais un bouton (donc macro il me semble) ou quand je clique dessus tous les Fabien (par exemple) se mettent en couleur. Et quand on reclic tout redevient normal.
Ceci est possible par la mise en forme conditionnelle mais on ne peut pas revenir à la normal sans tout refaire le processus....
Est-ce possible ?
En attente de vous lire, merci d'avance
Loris,

A voir également:

Macro colorer cellule
Excel colorer une cellule si - Guide
Macro word - Guide
Macro logiciel - Télécharger - Organisation
Aller à la ligne dans une cellule excel - Guide
Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur

2 réponses

Réponse 1 / 2

f894009 Messages postés 17189 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 6 mai 2024 1 705
27 déc. 2016 à 14:51

Bonjour,

un exemple:
double clic sur un prenom, toutes les cellules de ce prenom passent en vert
double clic sur le meme prenom ou double clic sur un autre prenom passage sans couleur du prenom precedent et passage en vert du prenom en cour

https://www.cjoint.com/c/FLBnZE6P0rf

Code dans VBA de le feuille

Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017
27 déc. 2016 à 15:50

c'est exactement ce que je cherchais ! Mais peut on rajouter une option ou quand on clique sur une cellule vide plus aucun prenom n'est coloré ?
Et ne m'y connaissant pas, comment rentrer ce que vous avez fait dans mon tableur et que cela fonctionne ?

f894009 Messages postés 17189 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 6 mai 2024 1 705 > Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017
Modifié par f894009 le 28/12/2016 à 07:45

Bonjour,

code a copier dans VBA de la feuille:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("A2:A" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(1), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(1).Find(Cel, Cells(lig, 1), , xlWhole).Row
                If Cells(lig, 1).Interior.Color = vbGreen Then
                    Cells(lig, 1).Interior.Pattern = xlNone
                Else
                    Cells(lig, 1).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("A" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("A2:A" & derlig)) Is Nothing Then
        Cancel = True
        Range("A2:A" & derlig).Interior.Pattern = xlNone
    End If
End Sub

Pour ouvrir la fenetre VBA, appuyez sur touches alt+F11, double clic sur la feuille en haut a gauche, copier/coller le code et essayez

Réponse 2 / 2

f894009 Messages postés 17189 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 6 mai 2024 1 705
28 déc. 2016 à 07:46

Re,

aperçu de la fenetre VBA avec code dans feuille

Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017
28 déc. 2016 à 18:17

Merci bien pour votre code, mais étant totalement incompétent (et je m'en excuse) en programmation, j'ai réussi à ouvrir la fenêtre via alt+F11 et puis je suis bloquer....
Je voulais également savoir si cette fonction de couleur selon le texte marche sur toute les colonnes ou uniquement sur celle souhaité (dans mon cas L) ?

Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017 > Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017
28 déc. 2016 à 21:12

Alors après recherche j'ai réussis à inserer mon code... Le probleme c'est qu'il marche pour la colonne A uniquement. Je le voudrais si possible sur la L

Bonjour,

Colonne L

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart

            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne A pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derlig).Interior.Pattern = xlNone
    End If
End Sub

Loriiiis Messages postés 20 Date d'inscription mercredi 3 août 2016 Statut Membre Dernière intervention 1 mars 2017 > f894009 Messages postés 17189 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 6 mai 2024
29 déc. 2016 à 20:28

Merci beaucoup d'avoir pris le temps de répondre à ce post, c'est très gentil. Toutefois si vous accepté de prendre encore quelque minutes pour compléter cette macro ce serai vraiment sympathique. je m'explique :
Tous les prénoms sont recensés (1 fois chacun) dans la colonne Q à partir de la ligne 47 jusqu’à infinis puisque je remets des prénoms tous les mois.
- Serait-il possible qu'eux se mettent également en couleur via le double clic ? (En synchronisation avec la colonne L)
- Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
J'insiste sur le fais que vous m'avez déjà bien aidé (je vous en remercie encore) et que je comprendrais que vous n'ayez pas envie de résoudre ces 2 petits soucis qu'il me reste.
Bien cordialement,

Bonjour,

Ok, mais
- Peut-on ajouter une option où aucune cellule n'est coloré (double clic dans la colonne N par exemple)
Vous avez deja le clic droit sur colonne L!!!!!!!!!!!!!!!!

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derlig = Range("L" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Application.ScreenUpdating = False
        Cel = Target.Value
        Range("L2:L" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(12), Cel)
        If Nb > 0 Then
            lig = 2 'ligne de depart
            For N = 1 To Nb
                lig = Columns(12).Find(Cel, Cells(lig, 12), , xlWhole).Row
                If Cells(lig, 12).Interior.Color = vbGreen Then
                    Cells(lig, 12).Interior.Pattern = xlNone
                Else
                    Cells(lig, 12).Interior.Color = vbGreen
                End If
            Next N
        End If
        derlig = Range("Q" & Rows.Count).End(xlUp).Row
        Range("Q47:Q" & derlig).Interior.Pattern = xlNone
        Nb = Application.CountIf(Columns(17), Cel)
        If Nb > 0 Then
            lig = 47 'ligne de depart
            For N = 1 To Nb
                lig = Columns(17).Find(Cel, Cells(lig, 17), , xlWhole).Row
                If Cells(lig, 17).Interior.Color = vbGreen Then
                    Cells(lig, 17).Interior.Pattern = xlNone
                Else
                    Cells(lig, 17).Interior.Color = vbGreen
                End If
            Next N
        End If
    End If
    Application.ScreenUpdating = True
End Sub

'clic droit sur cellules colonne Q et L pour enlever couleur
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Count > 1 Then Exit Sub
    derligL = Range("L" & Rows.Count).End(xlUp).Row
    derligQ = Range("Q" & Rows.Count).End(xlUp).Row
    If Not Application.Intersect(Target, Range("L2:L" & derlig)) Is Nothing Then
        Cancel = True
        Range("L2:L" & derligL).Interior.Pattern = xlNone
        Range("Q47:Q" & derligQ).Interior.Pattern = xlNone
    End If
End Sub

Discussions similaires

Excel : colorer une cellule sous condition d'une autre ?

Excel si cellule contient texte alors...

recup couleur de cellule sans macro

Discussions similaires

Newsletters