Macro Excel "MFC d'une forme"

Question

Bonjour,
Je souhaiterai effectuer une mise en forme conditionnelle dans Excel sur une forme. Seule une Macro permettrait de le faire et, ... j'y connais rien :-(

Je m'explique:
1. créer une forme dans une feuille excel, par exemple une ellipse
2. dire que cette ellipse est de couleur verte si la cellule A1 = "VALIDE" ou qu'elle est de couleur rouge si la cellule A1 = "REFUSE"

J'ai rien trouvé de bien détaillé à ce sujet sur les différents forum mais je suis sur que quelqu'un a deja du résoudre ce problème.

Merci de votre aide
Nicolas

Kahoèrre · Answer

Tu entend quoi par Ellipse? Un userform ?

lermite222 · Answer

Bonjour,
ActiveSheet.Shapes(1).Select
    With Selection
        .ShapeRange.Fill.ForeColor.SchemeColor = 3 ' vert
        .ShapeRange.Line.ForeColor.SchemeColor = 10 'Rouge
    End With
Bien entendu il faut sélectionner le bon indice de Shapes
A+

Mike-31 · Answer

Salut,

Lorsque tu crées un forme, dans la barre d'adresse tu trouveras son nom exemple lorsque tu pointes sur une cellule ex. B2 dans la barre d'adresse tu as B2, c'est la même chose avec les formes. Dans le code ci-dessous, c'est l'oval1, mais tu pourrais également nommer cette forme.

J'ai rajouté un Else qui supprime la couleur si un nom est différent en A1. 

Sub Macro2()
    If [A1] = "REFUSE" Then
    ActiveSheet.Shapes("Oval 1").Select
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    
    Else
    ActiveSheet.Shapes("Oval 1").Select
    Selection.ShapeRange.Fill.Visible = msoFalse
    
    End If
    If [A1] = "VALIDE" Then
    ActiveSheet.Shapes("Oval 1").Select
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 11
    Selection.ShapeRange.Fill.Visible = msoTrue
    Selection.ShapeRange.Fill.Solid
    End If
End Sub

ou comme cela

Sub Macro2()
    If [A1] = "REFUSE" Then
    ActiveSheet.Shapes("Oval 1").Fill.ForeColor.SchemeColor = 10
    ActiveSheet.Shapes("Oval 1").Fill.Visible = msoTrue
    Else
    ActiveSheet.Shapes("Oval 1").Fill.Visible = msoFalse
    End If
    If [A1] = "VALIDE" Then
    ActiveSheet.Shapes("Oval 1").Fill.ForeColor.SchemeColor = 11
    ActiveSheet.Shapes("Oval 1").Fill.Visible = msoTrue
    End If
End Sub

nicogc · Answer

SUPER MIKE !!! Ca fonctionne parfaitement !!!
Vraiment merci pour la qualité et la réactivité de ta réponse.

Si j'abuse ps trop, je souhaiterai rajouterai un petit bonus a ma demande, que la même macro fasse une chose en plus: écrire le texte d'une cellule dans la forme.

C a d, si l'on reprend l'exemple précédent, la couleur de l'ellipse est déterminé par la valeur de la cellule [A1] ET le texte de la cellule [A2] est écrit dans l'ellipse.

Je pense que ca ne devrais pas te poser trop de problème

Nicolas

Mike-31 · Answer

Re, J'ai nommé la A2 forme ovale et Inséré le texte cellule Sub Macro1 () Si [A1] = "Refuser" Alors ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 10 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue Autre ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoFalse End If Si [A1] = "VALIDE" Then ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 11 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue End If ActiveSheet.Shapes ( "Oval"). Sélectionner Selection.Characters.Text = [A2] End Sub A1 Pour un Déclenchement automatique des qu'en la valeur cller changer ce code Dans Les Propriétés feuille (clic droit sur l'onglet de feuille concernée / visualiser le code) Private Sub Worksheet_Change (ByVal Target As Range) Si Target.Address = "$ A $ 1" Then Si [A1] = "Refuser" Alors ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 10 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue Autre ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoFalse End If Si [A1] = "VALIDE" Then ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 11 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue End If ActiveSheet.Shapes ( "Oval"). Sélectionner Selection.Characters.Text = [A2] End If End Sub pour l'actualisation permanente des QU'UNE Une valeur feuille changement Private Sub Worksheet_Change (ByVal Target As Range) Si [A1] = "Refuser" Alors ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 10 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue Autre ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoFalse End If Si [A1] = "VALIDE" Then ActiveSheet.Shapes ( "Oval"). Fill.ForeColor.SchemeColor = 11 ActiveSheet.Shapes ( "Oval"). Fill.Visible = msoTrue End If ActiveSheet.Shapes ( "Oval"). Sélectionner Selection.Characters.Text = [A2] End Sub

nicogc · Answer

Merci beaucoup Mike
Super réponse
A+

Mike-31 · Answer

Re, 

si tes attentes sont satisfaites, confirme le moi que je mette le statut de cette discussion en résolu

merci

Macro Excel "MFC d'une forme"

7 réponses

Votre réponse

Discussions similaires

Newsletters