XL 2010 Appliquer une couleur de remplissage à une forme en fonction de la valeur d'une cellule

  • Initiateur de la discussion Initiateur de la discussion MARIO43
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

MARIO43

XLDnaute Nouveau
Bonjour
je voudrais savoir s'il est possible, via une macro VBA, d'appliquer une couleur de remplissage à une forme insérée dans un tableau et ceci en fonction de la valeur d'une cellule. Par exemple dans le fichier joint je voudrais remplir les 3 formes du "feu de circulation" . Pour la forme du haut avec la couleur rouge si D6=1, pour la forme du milieu avec la couleur orange si D7=2 et pour la forme du bas couleur verte si D8=3
Merci d'avance
 

Pièces jointes

Solution
Bonjour MARIO43, le forum,

La macro doit toujours être dans le code de la feuille des cellules D6 D7 D8 modifiées et il suffit de préciser la feuille où se trouvent les images :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Feuil1.Shapes("Ellipse 2").Visible = [D6] <> 1
Feuil1.Shapes("Ellipse 12").Visible = [D7] <> 2
Feuil1.Shapes("Ellipse 13").Visible = [D8] <> 3
End Sub
Feuil1 est le CodeName, fichier (2).

Bonne journée.
Bonjour,
Non c'est magique. 🙂

En feuil1 j'utilise un Worksheet_Change. Cette macro se lance quand une des cellules D6,D7,D8 change de valeur.
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$D$6" Or Target.Address = "$D$7" Or Target.Address = "$D$8" Then
    If Range("$D$6") = 1 Then
        Shapes("Rouge").Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        Shapes("Rouge").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    If Range("$D$7") = 2 Then
        Shapes("Orange").Fill.ForeColor.RGB = RGB(255, 255, 0)
    Else
        Shapes("Orange").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    If Range("$D$8") = 3 Then
        Shapes("Vert").Fill.ForeColor.RGB = RGB(0, 255, 0)
    Else
        Shapes("Vert").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    End If
    ' variante
    If Target.Address = "$D$26" Then
        Shapes("Rouge2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        Shapes("Orange2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        Shapes("Vert2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        If Target.Value = 1 Then
            Shapes("Rouge2").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ElseIf Target.Value = 2 Then
            Shapes("Orange2").Fill.ForeColor.RGB = RGB(255, 255, 0)
        ElseIf Target.Value = 3 Then
            Shapes("Vert2").Fill.ForeColor.RGB = RGB(0, 255, 0)
        End If
    End If
End Sub
 
Bonjour,
Non c'est magique. 🙂

En feuil1 j'utilise un Worksheet_Change. Cette macro se lance quand une des cellules D6,D7,D8 change de valeur.
VB:
Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address = "$D$6" Or Target.Address = "$D$7" Or Target.Address = "$D$8" Then
    If Range("$D$6") = 1 Then
        Shapes("Rouge").Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        Shapes("Rouge").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    If Range("$D$7") = 2 Then
        Shapes("Orange").Fill.ForeColor.RGB = RGB(255, 255, 0)
    Else
        Shapes("Orange").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    If Range("$D$8") = 3 Then
        Shapes("Vert").Fill.ForeColor.RGB = RGB(0, 255, 0)
    Else
        Shapes("Vert").Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
    End If
    ' variante
    If Target.Address = "$D$26" Then
        Shapes("Rouge2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        Shapes("Orange2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        Shapes("Vert2").Fill.ForeColor.RGB = RGB(255, 255, 255)
        If Target.Value = 1 Then
            Shapes("Rouge2").Fill.ForeColor.RGB = RGB(255, 0, 0)
        ElseIf Target.Value = 2 Then
            Shapes("Orange2").Fill.ForeColor.RGB = RGB(255, 255, 0)
        ElseIf Target.Value = 3 Then
            Shapes("Vert2").Fill.ForeColor.RGB = RGB(0, 255, 0)
        End If
    End If
End Sub
Merci mais la macro ne fonctionne pas. J'ai le message "erreur de compilation : End sub attendu"
 
Avec le fichier du post #2 ? chez moi ça marche sous XL2007.
20200618_161108.gif
 
Bonjour MARIO43, sylvanu,

Pourquoi colorer les formes ? Il suffit de les afficher ou masquer, c'est beaucoup plus simple.

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Shapes("Ellipse 2").Visible = [D6] <> 1
Shapes("Ellipse 12").Visible = [D7] <> 2
Shapes("Ellipse 13").Visible = [D8] <> 3
End Sub
Les 3 formes s'affichent ou se masquent automatiquement quand on modifie D6 D7 D8.

A+
 

Pièces jointes

Bonjour à tous,

Un essai, avec l'appareil photo
Bonjour MARIO43, sylvanu,

Pourquoi colorer les formes ? Il suffit de les afficher ou masquer, c'est beaucoup plus simple.

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Shapes("Ellipse 2").Visible = [D6] <> 1
Shapes("Ellipse 12").Visible = [D7] <> 2
Shapes("Ellipse 13").Visible = [D8] <> 3
End Sub
Les 3 formes s'affichent ou se masquent automatiquement quand on modifie D6 D7 D8.

A+
Un trés grand merci
 
Bonjour MARIO43, sylvanu,

Pourquoi colorer les formes ? Il suffit de les afficher ou masquer, c'est beaucoup plus simple.

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Shapes("Ellipse 2").Visible = [D6] <> 1
Shapes("Ellipse 12").Visible = [D7] <> 2
Shapes("Ellipse 13").Visible = [D8] <> 3
End Sub
Les 3 formes s'affichent ou se masquent automatiquement quand on modifie D6 D7 D8.

A+
Super. Merci à toi
 
Bonjour MARIO43, le forum,

La macro doit toujours être dans le code de la feuille des cellules D6 D7 D8 modifiées et il suffit de préciser la feuille où se trouvent les images :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
Feuil1.Shapes("Ellipse 2").Visible = [D6] <> 1
Feuil1.Shapes("Ellipse 12").Visible = [D7] <> 2
Feuil1.Shapes("Ellipse 13").Visible = [D8] <> 3
End Sub
Feuil1 est le CodeName, fichier (2).

Bonne journée.
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour