XL 2016 VBA mise en forme conditionnelle

[_l_ours]

Bonsoir à tous,

j'ai préparé un petit code VBA pour de la mise en forme conditionnelle (emplissage de l'intérieur de cellule selon les mots dans la cellule, mots issus d'une liste déroulante).
il y a 4 mots possibles, dont 3 que je souhaite mettre en forme avec une couleur.
Le problème est que mon code, avec 3 mises en forme conditionnelle, ne fonctionne pas, mais lorsque je teste uniquement condition par condition ça fonctionne.
voici le code en question :


Sub couleur_satisfaction()

With Sheets("Christelle").Range("u2 :u501")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="Satisfait"
.FormatConditions(1).Interior.Color = RGB(112, 173, 71)
End With

With Sheets("Christelle").Range("u2 :u501")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="Mitigé"
.FormatConditions(1).Interior.Color = RGB(255, 192, 0)
End With

With Sheets("Christelle").Range("u2 :u501")
.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="risque"
.FormatConditions(1).Interior.Color = RGB(255, 0, 0)
End With

End Sub

Un grand merci d'avance pour votre aide.

 

[TooFatBoy]

Bonjour,

Est-ce qu'il ne faudrait pas incrémenter l'indice du FormatConditions ?

Sub couleur_satisfaction()
'
    With Sheets("Christelle").Range("U2:U501")

        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="Satisfait"
        .FormatConditions(1).Interior.Color = RGB(112, 173, 71)

        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="Mitigé"
        .FormatConditions(2).Interior.Color = RGB(255, 192, 0)

        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:="risque"
        .FormatConditions(3).Interior.Color = RGB(255, 0, 0)

    End With

End Sub

[edit]
Je viens de tester, et ça à l'air de fonctionner avec l'incrémentation de l'indice du FormatConditions pour assigner la mise en forme à la bonne MFC.
[/edit]

 

[Staple1600]

Bonjour @_l_ours ,le fil

@_l_ours
Pour le fun, en attendant que j'aille farfouiller dans ma MFC
(mais ce sera après mon petit frichti du soir )

Sub I_cant_get_Satisfaction()
K_olor = Array(Array("Satisfait", RGB(112, 173, 71)), Array("Mitigé", RGB(255, 192, 0)), Array("risque", RGB(255, 0, 0)))
For Each c In Selection
On Error Resume Next
c.Interior.Color = Application.VLookup(c.Text, K_olor, 2, 0)
Next
End Sub

EDITION: Bonsoir @TooFatBoy
Mon navigateur n'avait pas rafraichi la page.

 

[Staple1600]

Re

Avec MFC en mixant avec syntaxe du message#3

Sub couleur_satisfaction_c()
Dim K_olor, i%
K_olor = Array(Array("Satisfait", RGB(112, 173, 71)), Array("Mitigé", RGB(255, 192, 0)), Array("risque", RGB(255, 0, 0)))
For i = LBound(K_olor) To UBound(K_olor)
    With Sheets("Christelle").Range("U2:U501")
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=K_olor(i)(0)
    .FormatConditions(i + 1).Interior.Color = K_olor(i)(1)
    End With
Next
End Sub

test ok sur Office 365

 

[Jacky67]

Bonjour à tous,
Je rajouterais quand même un
.FormatConditions.Delete
au cas que la macro est relancée
en début de macro

 

[Staple1600]

Bonjour @Jacky67

Je n'ajouterai ce .Delete uniquement quand j'entendrais ceci
https://www.youtube.com/watch?v=-GjqaxoQKi8
dans l'Excel du demandeur.


Ils osaient tout à l'époque !!!

 

[TooFatBoy]

Hello Jacky67

Je rajouterais quand même un
.FormatConditions.Delete
au cas que la macro est relancée
en début de macro

C'est sûr
que dans
l'absolu
il le
faudrait,
mais perso
je ne
l'ajouterai
que si le
demandeur
rencontre
un pb.


'jour Staple

 

[Jacky67]

Re

Avec MFC en mixant avec syntaxe du message#3

Sub couleur_satisfaction_c()
Dim K_olor, i%
K_olor = Array(Array("Satisfait", RGB(112, 173, 71)), Array("Mitigé", RGB(255, 192, 0)), Array("risque", RGB(255, 0, 0)))
For i = LBound(K_olor) To UBound(K_olor)
    With Sheets("Christelle").Range("U2:U501")
    .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=K_olor(i)(0)
    .FormatConditions(i + 1).Interior.Color = K_olor(i)(1)
    End With
Next
End Sub

test ok sur Office 365

Hello JM
Ah oui celle la est mieux
Ton test inclus plusieurs lancement ????

 

[Staple1600]

Re,

@Jacky67
Relire le message#6
Et surtout voir le lien dans ce même message (ou plutôt l'écouter )
Pour comprendre ma position sur le lancement ou le lancement de la position.

 

[Jacky67]

Re,

@Jacky67
Relire le message#6
Et surtout voir le lien dans ce même message (ou plutôt l'écouter )
Pour comprendre ma position sur le lancement ou le lancement de la position.

Oui mais .......
Si le demandeur teste la version #3, tu risques d'avoir un

non non rien n'a changé - Google Suche

Bon, moi je retourne à mon frichti à moi

frichti signification - Bing

Mit der intelligenten Bing-Suche können Sie die gewünschten Informationen schneller und einfacher finden und dabei Punkte sammeln.

www.bing.com

 

[Staple1600]

Re

@Jacky67
Désolé, mais je m'ennuyais dans mon VBE

Sub Couleur()
version Worksheets("Christelle")
End Sub
Private Sub version(Mick As Worksheet, Optional Jagger As String = "U2:U501")
Dim K_olor, i%
K_olor = Array(Array("Satisfait", vbGreen), Array("Mitigé", RGB(255, 192, 0)), Array("risque", vbRed))
    With Mick.Range(Jagger)
        .FormatConditions.Delete
        For i = LBound(K_olor) To UBound(K_olor)
            .FormatConditions.Add Type:=1, Operator:=3, Formula1:=K_olor(i)(0)
            .FormatConditions(i + 1).Interior.Color = K_olor(i)(1)
        Next
    End With
End Sub

 

[Jacky67]

Re

@Jacky67
Désolé, mais je m'ennuyais dans mon VBE

Sub Couleur()
version Worksheets("Christelle")
End Sub
Private Sub version(Mick As Worksheet, Optional Jagger As String = "U2:U501")
Dim K_olor, i%
K_olor = Array(Array("Satisfait", vbGreen), Array("Mitigé", RGB(255, 192, 0)), Array("risque", vbRed))
    With Mick.Range(Jagger)
        .FormatConditions.Delete
        For i = LBound(K_olor) To UBound(K_olor)
            .FormatConditions.Add Type:=1, Operator:=3, Formula1:=K_olor(i)(0)
            .FormatConditions(i + 1).Interior.Color = K_olor(i)(1)
        Next
    End With
End Sub

Maintenant, l'ours n'a plus qu' a bien se tenir
Ok Ok,,,,Je sors

Bonne nuit

 

[_l_ours]

Merci beaucoup à tous pour votre temps et vos solutions.
J'ai ai pris une (celle de @Staple1600 ) mais je vais toutes les regarder pour progresser