Discussion :

[phanoulevoyou]

Bonjour,

je trouve très chouette le MFC avec les jeux d'icônes cependant est-il possible de passer outre les règles obligatoires...

Je m'explique :

je souhaite que dans ma cellule s'affiche un bel icône fournit via ma MFC seulement si ma valeur est = (égal) à la valeur souhaitée.
Malheureusement dans ce type de MFC on nous donne la possibilité de faire du :

> ou >= ou < ou <=.... et à aucun moment du =

Pensez-vous qu'il y a un moyen de contourner cette règle obligatoire ?

Dans l'attente de vos réflexions ou d'une solution,

Cdlt, PLV.

[Invité]

Bonjour,

Ci-joint, un classeur exemple baptisé Substitut de MFC. Le principe est d'associer un smiley sous forme d'objet Shape, à une valeur ou à un intervalle.

Le classeur contient un module standard définissant les objets Shapes aux Smileys et les macros générant ou supprimant les objets en fonction de la valeur d'une aire "Résultats" dans la feuille Résultats.

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
 
Public SmileyToutVaBien As Shape
Public SmileyToutVaMal As Shape
Public SmileyCaSentMauvais As Shape
Public SmileyConvalescent As Shape
Public SmileyMerci As Shape
Public SmileyAChier As Shape
Public SmileyLol As Shape
 
Public Smiley As Shape
 
Public ShResultats As Worksheet
Public Cellule As Range
Public AireResultats As Range
 
 
Sub ChargerLesSmiley()
 
    Set SmileyToutVaBien = Sheets("Paramètres").Shapes("ToutVaBien")
    Set SmileyToutVaMal = Sheets("Paramètres").Shapes("ToutVaMal")
    Set SmileyCaSentMauvais = Sheets("Paramètres").Shapes("CaSentMauvais")
    Set SmileyConvalescent = Sheets("Paramètres").Shapes("EnConvalescence")
    Set SmileyMerci = Sheets("Paramètres").Shapes("Merci")
    Set SmileyAChier = Sheets("Paramètres").Shapes("AChier")
    Set SmileyLol = Sheets("Paramètres").Shapes("Lol")
 
End Sub
 
 
Sub DeChargerLesSmiley()
 
 
    Set SmileyToutVaBien = Nothing
    Set SmileyToutVaMal = Nothing
    Set SmileyCaSentMauvais = Nothing
    Set SmileyConvalescent = Nothing
    Set SmileyMerci = Nothing
    Set SmileyAChier = Nothing
    Set SmileyLol = Nothing
 
 
End Sub
 
 
Sub GenererLesSmileys()
 
 
        Set ShResultats = Sheets("Résultats")
        Set AireResultats = ShResultats.Range("Résultats")
 
        ' Supprimer les smileys existants dans l'aire résultats
        If ActiveSheet.Shapes.Count > 0 Then
           For Each Cellule In AireResultats
               For Each Smiley In ShResultats.Shapes
                   Select Case Smiley.Name
                          Case "Smiley" & Cellule.Address
                               ShResultats.Shapes("Smiley" & Cellule.Address).Delete
                               Exit For
                   End Select
               Next Smiley
           Next Cellule
        End If
 
        ChargerLesSmiley
 
        For Each Cellule In AireResultats
 
              With Cellule
                Select Case Cellule
 
                  Case Is < -10000
                          SmileyLol.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
 
                  Case -10000 To -1000
                          SmileyAChier.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
 
                  Case -999 To -100
 
                          SmileyToutVaMal.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
 
                  Case -99 To 0
                          If Cellule <> "" Then
                                SmileyCaSentMauvais.Copy
                                Cellule.Select
                                ActiveSheet.Paste
                                Selection.Name = "Smiley" & Cellule.Address
                          End If
                 Case 1 To 10
                          SmileyConvalescent.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
                 Case 11 To 100
                          SmileyToutVaBien.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
                  Case Is > 100
                          SmileyMerci.Copy
                          Cellule.Select
                          ActiveSheet.Paste
                          Selection.Name = "Smiley" & Cellule.Address
                End Select
 
            End With
 
      Next Cellule
 
      DeChargerLesSmiley
 
      Set AireResultats = Nothing
      Set ShResultats = Nothing
 
End Sub
 
 
Sub SupprimerLesSmileys()
 
 
        Set ShResultats = Sheets("Résultats")
        Set AireResultats = ShResultats.Range("Résultats")
 
        ' Supprimer les smileys existants dans l'aire résultats
        If ActiveSheet.Shapes.Count > 0 Then
           For Each Cellule In AireResultats
               For Each Smiley In ShResultats.Shapes
                   Select Case Smiley.Name
                          Case "Smiley" & Cellule.Address
                               ShResultats.Shapes("Smiley" & Cellule.Address).Delete
                               Exit For
                   End Select
               Next Smiley
           Next Cellule
        End If
 
 
      Set AireResultats = Nothing
      Set ShResultats = Nothing
 
End Sub

Pour la saisie au coup par coup dans l'aire Résultats, une macro événementielle sur changement de valeur dans l'aire Résultats

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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 
Private Sub WorkSheet_Change(ByVal Target As Range)
 
   If Target.Count > 1 Then Exit Sub
 
   If Not Application.Intersect(Target, Range("Résultats")) Is Nothing Then
 
        ' Supprimer le smiley existant
        If ActiveSheet.Shapes.Count > 0 Then
            For Each Smiley In ActiveSheet.Shapes
                Select Case Smiley.Name
                    Case "Smiley" & Target.Address
                     ActiveSheet.Shapes("Smiley" & Target.Address).Delete
                     Exit For
                End Select
            Next Smiley
        End If
 
 
        ChargerLesSmiley
 
 
        With Target
          Select Case Target
 
 
            Case Is < -10000
                    SmileyLol.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
 
            Case -10000 To -1000
 
                    SmileyAChier.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                    Exit Sub
 
            Case -999 To -100
 
                    SmileyToutVaMal.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                    Exit Sub
 
            Case -99 To 0
                    If Target <> "" Then
                    SmileyCaSentMauvais.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                    Exit Sub
                    End If
           Case 1 To 10
 
                    SmileyConvalescent.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                     Exit Sub
 
           Case 11 To 100
 
                    SmileyToutVaBien.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                    Exit Sub
 
            Case Is > 100
 
                    SmileyMerci.Copy
                    Target.Select
                    ActiveSheet.Paste
                    Selection.Name = "Smiley" & Target.Address
                     Exit Sub
 
          End Select
 
      End With
 
      DeChargerLesSmiley
 
 
    End If
 
 
End Sub

Pour ajouter ou modifier des smileys, voir la feuille Paramètres.

Cordialement.

[78chris]

Bonjour

On trouve souvent des contournements : mais cela dépend beaucoup des cas de figure donc sans plus de détails...

[phanoulevoyou]

Bonjour Éric et Chris...

Alors merci Éric pour ce petit bijou de fichier mais je n'en demandais pas tant...
mais je garde ton fichier sous le coude au cas ou...

Pour ce qui est de mon souhait c'est juste de savoir si on peut utiliser la MFC avec le jeux d'icônes et changer les symboles < ou > en simple =...

Exemple : je veux que ma MFC s'applique comme cela :

si A1 = 100 alors feu vert si A1<100 et >=50 alors feu orange si A1 <50 et >0 alors feu rouge.
et si A1 dépasse 100 soit A1>100 alors feu orange...

Donc ce que je souhaiterai c'est une et une seule condition pour avoir le feu vert, ce qui n'est actuellement pas possible avec la MFC et le jeux d'icônes car on ne peut pas lui appliquer un simple "=".

Maintenant si c'est pas possible ne vous prenez pas la tête, je me passerai de cette mise en forme...

Merci,
Cdlt, PLV.

[78chris]

Bonjour

Tu prends un jeu de 4 icones.

1. 1ère icône : tu choisis le rond orange ou autre forme (il y a une liste déroulante pour changer l'icône) et pour la règle nombre >100
2. 2ème icône : tu choisis le rond vert et pour la règle nombre >=100
3. 3ème icône : tu choisis le rond orange et pour la règle nombre >=50
4. 4ème icône : tu choisis le rond rouge
   

[phanoulevoyou]

Bonsoir Chris,

je ne vois pas ce que tu me dis

Code :

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

1ère icône : tu choisis le rond orange ou autre forme (il y a une liste déroulante pour changer l'icône) et pour la règle nombre >100

je ne peux qu'inverser les couleurs (noir, rouge, jaune, vert ou vert jaune, rouge, noir) et donc je ne peux pas choisir que tel couleur correspondra à tel donnée...

Ce qui fait que mon code couleur ne sera pas en adéquation avec la logique des nombres. Dans un cas si je mets le vert en haut ma valeur ne peut être que >= ou > et dans le second cas si je mets la couleur noire en haut c'est compréhensible dans le cas ou ma valeur est supérieure à 100 mais ce n'est plus compréhensible pour la couleur verte qui se retrouve en bas de tableau et dont la valeur ne peut être que "si <..." et donc ne correspondra pas à l'attente.

Bon je ne suis pas sur que je puisse faire ce dont j'aurai souhaité, je laisse encore le temps aux réflexions et s'il n'y a pas de solution j'enlèverai cette discussion.

Merci beaucoup pour l'aide,
Cdlt, PLV.

[78chris]

Bonjour

Je vois que tu as 2007 : c'est différent dans 2010 où on peut changer d'icône et même mélanger des type différents.

Par contre tu as bien la possibilité de remplacer pourcentage par nombre mais cela ne résoudra pas ton problème car tu auras 4 couleurs différentes et non celles que tu voulais.

[Stef999]

Bjr,

Dans une MFC 2007 on peut faire
icone1 si > x
icone2 si <=x et >= x (autrement dit = x)
icone3 si < x

je sais que ça ne répond pas vraiment au besoin d'égalité simple

et autrement mais il faut que le contexte s'y prête :

un format de nombre personnalisé
exemple :
;;"J"
en format personnalisé affiche un J à la place du 0 ... et le J c'est un smiley en Wingdings

[phanoulevoyou]

Bonjour,

Je remercie ceux qui se sont penchés sur ce petit problème pour essayer de trouver une solution.

Je clôture cette discussion et me passerai d'icône pour enjoliver mes petites cellules.

Bonne journée à tous.

PLV.