Changer la couleur de fond d'une cellule avec clic droit

**cyr.odi** · 06/09/2012, 11h37

Bonjour,

Je viens quémander un peu d'aide auprès de gens compétents

J'essaye depuis quelques temps de réaliser un petit fichier de réservation de salle qui soit convivial. Pour ce faire, je souhaitais que les utilisateurs n'ait juste qu'à faire un clic droit pour faire défiler une couleur dans une cellule (plage horaire) en partant du principe qu'à chaque service correspondait une couleur.

Alors j'ai fouillé, j'ai trouvé du code et j'ai adapté. Seulement je me confronte à un problème : lorsque je veux changer ma plage de couleurs, ça ne marche plus aussi bien. Je m'explique :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
ActiveSheet.Unprotect
couleurs = Array(RGB(255, 204, 153), RGB(153, 204, 0), RGB(153, 204, 255), RGB(255, 255, 255))
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 4)
Cancel = True
ActiveSheet.Protect
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End Sub

Avec ce code, ça marche impeccable. Les 4 couleurs défilent dans l’ordre voulu. Seulement j'ai jugé que ces couleurs étaient trop sombre et j'ai voulu les modifier pour que le texte à l'intérieur des cellules ressorte mieux. J'ai modifié mon tableau de couleurs comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

couleurs = Array(RGB(255, 204, 153), RGB(220, 244, 0), RGB(220, 244, 255), RGB(255, 255, 255))

Eh ben là ça ne marche plus du tout! Il affiche la première couleur, puis la 2ème, puis il revient sur la première en laissant la feuille déprotégée

Et il recommence, si bien que je ne tourne que sur 2 couleurs.

Dans la mesure où je n'ai touché QU'AU tableau, je pige pas...

Et par ailleurs, je croyais que mettre la macro dans "ThisWorkbook" la ferait fonctionner pour toutes les feuilles. Or dans les faits, ça ne marche pas du tout. Il faut que je la recopie pour chaque feuille ce qui est très pénible lorsque j'apporte des modifications.

Si quelqu'un a une idée, merci d'avance

**issoram** · 06/09/2012, 11h49

Bonjour,

Il n'y a aucune raison que la modification de ton tableau de couleurs change quoique ce soit.

Par contre tu devrais te pencher sur ces 2 lignes (plus particulièrement la deuxième)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
On Error GoTo color
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 4)

La 2eme ligne doit (à mon avis) doit générer une erreur et du coup te renvoyer à la gestion d'erreur ici (en omettant toutes les lignes qui suivent:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
color:
Target.Interior.color = couleurs(0)
Cancel = True

Donc la feuille n'est pas reprotégée et on affiche la première couleur

Cordialement

**cyr.odi** · 06/09/2012, 12h17

Merci pour ta réponse.

Effectivement, je partage l'analyse. Ce qui m'étonne, c'est que la simple modification des couleurs crée cette erreur.

Maintenant je ne suis pas une star en VBA et je m'étonnais que le "couleurs" soit sans parenthèse dans les paramètres de "Application.WorksheetFunction.Match".

Ca m'aurait arrangé que quelqu’un m'explique...

**issoram** · 06/09/2012, 14h17

Tu peux commenter les lignes

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

On Error goto color

et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
color:
Target.Interior.color = couleurs(0)
Cancel = True

et nous dire quel message d'erreur tu obtiens.

**cyr.odi** · 06/09/2012, 15h50

En fait, je n'ai aucun message d'erreur. La situation est telle que je la décris, avec un cycle sur 2 couleurs au lieu de 4 comme obtenu avec le premier code.

Et pour le peu que je connaisse le VBA, si je ne me trompe pas, le code que tu as relevé dit que sur une erreur (mais laquelle? je ne sais pas) la première couleur du tableau est affectée à la cellule active. Comme on est sorti de la boucle, la feuille est déprotégée.

Mais bon, comme je l'expliquais, c'est du code que j'ai récupéré sur Internet et que j'ai essayé d'adapter (avec un roulement de 4 couleurs au lieu de 3) et mon premier code fonctionne...

**issoram** · 06/09/2012, 16h44

Tu as bien enlevé les lignes de gestion d'erreur?
S'il n'y a pas d'erreur le code passe forcément à cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Protect

et la feuille est protégée.

**gFZT82** · 06/09/2012, 17h57

Bonjour,

Pour ma part, j’ai testé le code avec les nouvelles couleurs et je n’ai pas rencontré de problème particulier.
Le résultat correspond bien à l’attendu, à savoir un changement itératif des 4 couleurs de fond à chaque clic droit.

Cordialement.

**cyr.odi** · 07/09/2012, 11h07

Bonjour à tous et merci pour votre aide

Envoyé par issoram

Tu as bien enlevé les lignes de gestion d'erreur?
S'il n'y a pas d'erreur le code passe forcément à cette ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.Protect

et la feuille est protégée.

Alors je n'avais pas compris sur ton message initial qu'il fallait que je supprime quelque chose. Tu avais dit "commenter", du coup je croyais qu'il fallait que j'explique...

Une fois les dites lignes supprimées, il y a une erreur au 3ème clic et le message est "Erreur d'exécution 1004 - Impossible de lire la propriété Match de WorksheetFunction"

Envoyé par gFZT82

Bonjour,

Pour ma part, j’ai testé le code avec les nouvelles couleurs et je n’ai pas rencontré de problème particulier.
Le résultat correspond bien à l’attendu, à savoir un changement itératif des 4 couleurs de fond à chaque clic droit.

Cordialement.

Merci pour ton aide mais quand moi je lance ton classeur, je ne tourne que sur 2 couleurs : saumon et jaune. Est-ce qu'il peut y avoir un conflit avec quelque chose?

**issoram** · 07/09/2012, 13h08

Bonjour,

Non commenter signifiait: commenter la ligne de code en la préfixant d'une côte (comme pour ajouter des commentaires dans un code

)

Bref, pour ton souci, c'est que la fonction Match échoue et ne trouve pas la couleur de la cellule active dans ta liste => du coup affecte la première couleur du tableau, comme la gestion d'erreur lui indique.

Est ce que tu peux tester ceci et me dire ce que ça renvoie pour les 3 clics:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim couleurs()
ActiveSheet.Unprotect
couleurs = Array(RGB(255, 204, 153), RGB(153, 204, 0), RGB(153, 204, 255), RGB(255, 255, 255))
On Error GoTo color
msgbox Target.Interior.color 
Target.Interior.color = couleurs(Application.WorksheetFunction.Match(Target.Interior.color, couleurs, 0) Mod 4)
Cancel = True
ActiveSheet.Protect
Exit Sub
color:
Target.Interior.color = couleurs(0)
Cancel = True
End Sub

**cyr.odi** · 07/09/2012, 14h27

J'avais pas compris

Alors il se passe dans l'ordre :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
- Clic droit dans la cellule
- Affichage de la valeur 16777215 en msgbox
- Je clique sur "OK"
- J'ai la couleur saumon dans la cellule
- Je reclique sur la cellule
- Affichage de la valeur 10079487 en msgbox
- Je clique sur "OK"
- J'ai la couleur vert "vase" dans la cellule
- Je reclique sur la cellule
- Affichage de la valeur 32896 en msgbox
- Je clique sur "OK"
- J'ai à nouveau la couleur saumon dans la cellule
- Je reclique sur la cellule
- Affichage de la valeur 10079487 en msgbox
- Je clique sur "OK"
- J'ai la couleur vert "vase" dans la cellule
- Je reclique sur la cellule
- Affichage de la valeur 32896 en msgbox
- Je clique sur "OK"
- J'ai la couleur saumon dans la cellule
- Je reclique sur la cellule
- Affichage de la valeur 10079487 en msgbox
- Je clique sur "OK"
- J'ai la couleur vert "vase" dans la cellule...

Bref, ça tourne en boucle à partir du moment où on a la valeur "10079487" qui s'affiche.

Pour mon problème, finalement, est-ce que ce n'est pas que je fais appel à un code couleur qui serait "hors range"? Ca me paraissait bizarre parce que je croyais qu'en VBA on pouvait appeler toutes les couleurs prévues sous Excel...

En tout cas merci

**issoram** · 07/09/2012, 15h04

C'était tes premières couleurs => donc déjà ça plante dans les 2 cas.

Bref, ça tourne en boucle à partir du moment où on a la valeur "10079487" qui s'affiche.

En fait c'est la couleur 32896 qu'il ne trouve pas dans ton tableau. Si tu fais un

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Debug.Print RGB(255, 204, 153), RGB(153, 204, 0), RGB(153, 204, 255), RGB(255, 255, 255)

tu obtiens:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

10079487      52377         16764057      16777215

Donc à un moment donné la cellule à la couleur 32896 alors qu'elle devrait prendre la 52377.
Est que tu es sûr que rien ne se passe entre les 2 clics (événement etc.).

Sinon essaie ceci sur n'importe quelle cellule et dis mois ce que ça renvoie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testCouleur()
    Debug.Print RGB(153, 204, 0)
    ActiveCell.Interior.Color = RGB(153, 204, 0)
    degug.Print ActiveCell.Interior.Color
End Sub

**gFZT82** · 07/09/2012, 15h35

Bonjour,

Tu peux lancer ce test pour vérifier si tu obtiens les mêmes couleurs à l'écriture et à la lecture.

**cyr.odi** · 07/09/2012, 15h57

Envoyé par issoram

Est que tu es sûr que rien ne se passe entre les 2 clics (événement etc.).

Eh ben rien visuellement

Envoyé par issoram

Sinon essaie ceci sur n'importe quelle cellule et dis mois ce que ça renvoie:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub testCouleur()
    Debug.Print RGB(153, 204, 0)
    ActiveCell.Interior.Color = RGB(153, 204, 0)
    degug.Print ActiveCell.Interior.Color
End Sub

Je t'ai mis la copie écran : une erreur "400"...

Envoyé par gFZT82

Tu peux lancer ce test pour vérifier si tu obtiens les mêmes couleurs à l'écriture et à la lecture.

Pas du tout!

Je t'ai mis le résultat en pièce jointe également.

C'est grave docteur?

**gFZT82** · 07/09/2012, 16h44

Le test montre que tu ne peux pas utiliser les 2 couleurs RVB(220, 244, 0) et RVB(220, 244, 255).
Fais un essai avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

couleurs = Array(RGB(255, 204, 153), RGB(255, 255, 0), RGB(204, 255, 255), RGB(255, 255, 255))

Cordialement.

**cyr.odi** · 08/09/2012, 16h02

Merci encore de votre aide à tous.

J'ai voulu répondre hier soir avec mon smartphone mais mon message a apparemment sauté

à gFZT82 : Effectivement, ça semble une incompatibilité des codes. Si quelqu'un comprend, ça serait bien d’expliquer. Sinon comme je disais précédemment, je suis sorti du buraeu et n'ai plus accès à ma machine avant lundi. Je me propose de faire les tests (et même plus s'il s'agit de trouver des "range" compatibles) et de revenir ici donner les résultats.

Merci et bon week-end!

**gFZT82** · 08/09/2012, 19h03

Bonjour,

Le nombre de couleurs par classeur est limité à 56 avec EXCEL 2003.
Limites-et-specifications-excel-2003

Cordialement.

**kiki29** · 08/09/2012, 19h27

Salut, pour info, si ce code peut aider

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
Option Explicit
 
Sub Couleurs()
Dim Ws As Worksheet
Dim RGBc As Long
Dim B As Integer, G As Integer, R As Integer
Dim i As Long
Dim iRow As Long, iCol As Long
Dim Ar() As Variant
 
    Set Ws = ActiveWorkbook.Worksheets.Add
 
    With Ws
        .Cells(1, 3) = "R"
        .Cells(1, 4) = "G"
        .Cells(1, 5) = "B"
    End With
 
    '   56 Couleurs Standards
    For i = 1 To 56
        With Ws
            .Cells(i + 1, 1).Interior.ColorIndex = i
            .Cells(i + 1, 2) = i
 
            RGBc = .Cells(i + 1, 1).Interior.Color
            R = Int(RGBc Mod 256)
            G = Int((RGBc Mod 65536) / 256)
            B = Int(RGBc / 65536)
            .Cells(i + 1, 3) = R
            .Cells(i + 1, 4) = G
            .Cells(i + 1, 5) = B
            .Cells(i + 1, 6) = RGBc
        End With
    Next i
 
    '   40 Couleurs Disponibles dans Menu Couleur Cellules
    Ar = Array(1, 53, 52, 51, 49, 11, 55, 56, _
               9, 46, 12, 10, 14, 5, 47, 16, _
               3, 45, 43, 50, 42, 41, 13, 48, _
               7, 44, 6, 4, 8, 33, 54, 15, _
               38, 40, 36, 35, 34, 37, 39, 2)
 
    With Ws
        i = 1
        For iRow = 1 To 5
            For iCol = 1 To 8
                .Cells(iRow + 1, 6 + iCol).Interior.ColorIndex = Ar(i - 1)
                .Cells(iRow + 1, 6 + iCol) = Ar(i - 1)
                i = i + 1
            Next iCol
        Next iRow
 
        With .Range("G2:N6")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
 
        .Columns("G:N").ColumnWidth = 2
        .Range("O1").Select
    End With
End Sub

**cyr.odi** · 10/09/2012, 09h28

Génial ce dernier code! On ne risque plus de se tromper

Il marche très bien chez moi.

Envoyé par gFZT82

Le test montre que tu ne peux pas utiliser les 2 couleurs RVB(220, 244, 0) et RVB(220, 244, 255).
Fais un essai avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

couleurs = Array(RGB(255, 204, 153), RGB(255, 255, 0), RGB(204, 255, 255), RGB(255, 255, 255))

Cordialement.

Ça marche impeccable

Envoyé par gFZT82

Bonjour,

Le nombre de couleurs par classeur est limité à 56 avec EXCEL 2003.
Limites-et-specifications-excel-2003

Cordialement.

J'entends bien mais il n'y en a que 40 à disposition sur le classeur pour les fond et texte. Et en plus, j'avais fait attention à coder des couleurs également présentes dans ma palette. C'est là où je ne comprenais pas...

Bon en tout cas, un grand merci à tous et je vais pouvoir marquer l'affaire comme résolue. Je vais juste attendre un chouïa pour vérifier que personne n'a la réponse à la 2ème partie de la question, à savoir pourquoi le fait de mettre la macro dans le WorkBook ne marche pas, m'obligeant à la recopier pour chaque feuille.

Si personne n'a de suggestion, je clorai le topic demain en marquant résolu

**gFZT82** · 10/09/2012, 10h17

Bonjour,

J'ai placé le code suivant dans le module ThisWorkBook et je n'ai pas rencontré de problème particulier

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Dim Couleurs()
    Sh.Unprotect
    Couleurs = Array(RGB(255, 204, 153), RGB(255, 255, 0), RGB(204, 255, 255), RGB(255, 255, 255))
    On Error GoTo color
    Target.Interior.color = Couleurs(Application.WorksheetFunction.Match(Target.Interior.color, Couleurs, 0) Mod 4)
    Cancel = True
    Sh.Protect
    Exit Sub
color:
    Target.Interior.color = Couleurs(0)
    Cancel = True
End Sub

Cordialement.