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

[MARIO43]

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

 

[sylvanu]

Bonjour Mario,
Un essai en PJ, plus une variante avec une seule cellule.

 

[MARIO43]

Bonjour Mario,
Un essai en PJ, plus une variante avec une seule cellule.

Merci pour ta réponse mais il n'y a pas de macro;

 

[sylvanu]

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.

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

 

[MARIO43]

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.

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"

 

[sylvanu]

Avec le fichier du post #2 ? chez moi ça marche sous XL2007.

 

[job75]

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) :

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+

 

[djidji59430]

Bonjour à tous,

Un essai, avec l'appareil photo

 

[MARIO43]

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) :

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

 

[MARIO43]

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) :

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

 

[MARIO43]

Super. Merci à toi

Bonjour
Une petite question : comment faire si les cellules de référence sont sur une autre feuille du classeur ?

 

[job75]

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 :

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.