Couleur de cellules en fonction de leurs valeur

Le 17/12/2016 à 17:31

Bonsoir ,

Je cherche un code VBA pour mettre les fonds de cellules d'une certaine couleur en fonction de leurs valurs :

Pour les cellules de C5 à L46 , si elles contiennent " 5 " fond rouge , si elles contiennent "55" fond vert , si elles contiennent "4" fond bleu , si elles contiennent " 44" fond vert , si elles contiennent "1" fond jaune.

Je vous remercie par avance pour votre aide.

Le 17/12/2016 à 17:37

Salut,

Pourquoi ne fais-tu pas simplement une MFC ?

Un fichier type aurait été plus simple aussi.

Le 17/12/2016 à 17:45

Je suis limitée à 3 MFC.

Je penses qu'avec un code VBA je pourrais programmer une quinzaine de formats .

Le 17/12/2016 à 17:48

Ah oui en effet je n'avais pas vu le "Excel 2003" ..

N'y connaissant rien en VBA je vais laisser les autres pro t'aider.

Bon courage !

Le 17/12/2016 à 17:50

Bonjour Isabelette,

avec VBA, tu peux programmer autant de couleurs que tu le souhaites avec autant de critères que tu le souhaites!

Pas de limites à l'imagination tant qu'elle puisse être calculable, évidemment!

Deux solutions, ici, par MFC et par VBA.

A+

27couleursvba.xlsm (13.19 Ko)
25couleursmfc.xlsx (7.86 Ko)
Le 17/12/2016 à 18:24

Bonsoir , merci pour tes fichiers.

Mais le fichier en VBA est brouillé car j'utilise Excel 2003 et je ne vois pas de code VBA .

Le 17/12/2016 à 19:13

Bonsoir Isabelette,

désolé, pas compétent pour les conflits de version! Voici le code :

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("C5:L46")) Is Nothing Then
    Select Case Target.Value
        Case Is = 5
            Target.Interior.Color = RGB(255, 0, 0)
        Case Is = 55
            Target.Interior.Color = RGB(0, 255, 0)
        Case Is = 4
            Target.Interior.Color = RGB(0, 176, 240)
        Case Is = 44
            Target.Interior.Color = RGB(0, 255, 0)
        Case Is = 1
            Target.Interior.Color = RGB(255, 255, 0)
    End Select
End If
'
End Sub

Joyeuses Fêtes!

A+

Le 18/12/2016 à 10:33

Bonjour ,

Super merci cela fonctionne.

Pour améliorer le code serait il possible d'appliquer ce code à toutes les cellules C5:L46 en même temps ?

Le 18/12/2016 à 11:09

Bonjour,

Es-tu sûre que cela améliorerait de colorer toute les cellules de la plage chaque fois que tu modifies la valeur d'une cellule... ?

Curulis :

avec VBA, tu peux programmer autant de couleurs que tu le souhaites avec autant de critères que tu le souhaites!

Jusqu'à la version 2003, Excel n'affiche que les 56 couleurs de la palette...

Cordialement.

Le 18/12/2016 à 11:29

Oui , ce serait pour remettre en ordre les couleurs sur plusieurs tableaux sans les repasser 1 à 1 .

Le 18/12/2016 à 12:04

Tu modifies ainsi la procédure de Curulis :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Application.ScreenUpdating = False
    For Each c In Intersect(Target, Me.Range("C5:L46"))
        Select Case c.Value
            Case 5: c.Interior.Color = RGB(255, 0, 0)
            Case 55: c.Interior.Color = RGB(0, 255, 0)
            Case 4: c.Interior.Color = RGB(0, 176, 240)
            Case 44: c.Interior.Color = RGB(0, 255, 0)
            Case 1: c.Interior.Color = RGB(255, 255, 0)
        End Select
    Next c
End Sub

Pour mettre à jour, tu copies la plage et la colles sur elle-même, cela entraînera la mise à jour de toutes les cellules.

NB-Tu parles de plusieurs tableaux ??? La procédure ne s'applique qu'à un seul tableau d'une seule feuille ! Si cela doit concerner plusieurs feuilles, il faut lui apporter quelques modifs et la placer dans ThisWokbook au lieu d'un module de feuille.

NB pour Curulis : Is est obligatoire avec un opérateur de comparaison : =, <, >, <=, >=... mais l'utilisation de = n'est pas obligatoire pour une comparaison d'égalité, donc : Case 5 fonctionne pareil que Case Is = 5 (mais c'est plus court ! )

Le 18/12/2016 à 12:31

Bonjour,

Ajoute cette macro qui initialise les couleurs sur la plage sélectionnée :

Sub colorSel()
    Dim c As Range
    For Each c In Selection
        If IsNumeric(c) And c <> "" Then Worksheet_Change c
    Next c
End Sub

Edit : ah, je n'avais pas vu la page 2 et que que MFerrand t'avais répondu.

Cette proposition permet de conserver que le Change ne s'applique que sur la cellule concernée.

Le 18/12/2016 à 12:49

Salut Eric,

Tu me fais justement penser que reprenant le code de Curulis, je n'ai pas pensé à la décoloration... ! un cas Else s'impose...

Mais attendons la réponse à la question de l'étendue de l'application de la chose.

Le 18/12/2016 à 13:30

Bonjour tout le monde,

MFerrand, Eriic,

merci pour les petites notes, MFerrand... tant de choses que j'ignore encore!

Merci de garder l'oeil sur l'affaire : je sors difficilement d'un traquenard au peket dans lequel je suis tombé hier soir!

Jamais vu pareil marché de Noël!

Bonne journée!

A+

Le 18/12/2016 à 13:41

peket C'est quoi ça ?

Le 18/12/2016 à 19:59

Bonsoir , je me bat à essayer d'adapter le code.

Je ne comprends pas pourquoi parfois le code couleur n'est pas respecté : par exemple toutes les cellules ont un fond rouge.

Je joint un exemple.

12cycle.zip (18.02 Ko)
Le 18/12/2016 à 20:19

Bonsoir,

Commence par supprimer tes MFC si tu veux voir si ça fonctionne ou non ! ....

Le 18/12/2016 à 20:55

Bonsoir Isabelette,

les brumes du peket se dissipant gentiment et celles du castagnou n'étant pas encore tombées (vive Noël! ), j'ose ceci :

Private Sub Worksheet_Change(ByVal Target As Range)
'
Application.ScreenUpdating = False
'
Select Case Target
    Case 1
        Target.Interior.Color = RGB(255, 255, 0)
    Case 3
        Target.Interior.Color = RGB(224, 96, 0)
    Case 4
        Target.Interior.Color = RGB(0, 176, 240)
    Case 5
        Target.Interior.Color = RGB(225, 0, 64)
    Case 44
        Target.Interior.Color = RGB(0, 255, 0)
    Case 55
        Target.Interior.Color = RGB(255, 0, 0)
    Case Else
        Target.Interior.ColorIndex = xlNone
End Select
'
Application.ScreenUpdating = True
'
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
'exit sub
Dim rCells As Range
Dim rCel As Range
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
iRow = Range("B" & Rows.Count).End(xlUp).Row
iCol = Cells(5, Columns.Count).End(xlToLeft).Column
sCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
Set rCells = Range("C7:" & sCol & iRow)
'
If Not Application.Intersect(Target, rCells) Is Nothing Then
    For Each rCel In rCells
        Select Case rCel.Value
            Case 1
                rCel.Interior.Color = RGB(255, 255, 0)
            Case 3
                rCel.Interior.Color = RGB(224, 96, 0)
            Case 4
                rCel.Interior.Color = RGB(0, 176, 240)
            Case 5
                rCel.Interior.Color = RGB(225, 0, 64)
            Case 44
                rCel.Interior.Color = RGB(0, 255, 0)
            Case 55
                rCel.Interior.Color = RGB(255, 0, 0)
            Case Else
                rCel.Interior.ColorIndex = xlNone
        End Select
    Next
End If
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
  • SelectionChange ne doit servir normalement qu'UNE seule fois par feuille à traiter (en espérant une structure IDENTIQUE dans chaque feuille) dans sa globalité! Ensuite, soit, éliminer le code ou enlever l'apostrophe devant EXIT SUB.
  • Change est utile pour un usage ponctuel.

@MFerrand

http://www.maisondupeket.be/peket/

Bienvenue en Wallonie!

A+

Le 20/12/2016 à 09:51

Bonjour , Merci ce code me fais gagner un temps précieux.

Sur le planning suivant je voudrais l'affiner en colorant en bleu les cellule " T5 " entourées par des cellules " R " contigües .

7cycle2.zip (24.03 Ko)
Le 21/12/2016 à 01:38

Bonjour Isabelette,

Des couleurs, en veux-tu, en voici...

Juste un petit bouton bleu à cliquer en haut à gauche!

Un vrai sapin de Noël, ton tableau! Ça tombe bien!

A+

9cycle2.xlsm (62.04 Ko)
Rechercher des sujets similaires à "couleur fonction leurs valeur"