XL 2016 simplifier une macro enregistrée

[dindin]

Bonjour,
Comment faire pour simplifier cette macro enregistrée

Sub couleur()
'
' couleur Macro

    Range("D15:j200").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""CA"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0
    End With
   
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""RTT"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0
    End With
   
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=""CR"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0
    End With
 
End Sub

c'est une liste de 7 choix, donc en MFC c'est trop long

 

[sylvanu]

Bonsoir Dinidin,
A essayer :

Sub Couleur()
    Set Plage = Range("D15:j200")
    Plage.FormatConditions.Delete
    Texte = "CA":   Fond = xlThemeColorAccent5: MFC Plage, Texte, Fond
    Texte = "RTT":  Fond = xlThemeColorAccent6: MFC Plage, Texte, Fond
    Texte = "CR":   Fond = xlThemeColorAccent3: MFC Plage, Texte, Fond
End Sub
Sub MFC(Plage, Texte, Fond)
    With Plage
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=Texte
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.ThemeColor = Fond
    End With
End Sub

Pour rajouter une MFC il suffit de rajouter dans Couleur la ligne :

Texte = "TEXTE":   Fond = COULEUR: MFC Plage, Texte, Fond

 

[sylvanu]

Ou peut être plus simple, à vous de voir :

Sub Couleur2()
    Range("D15:J200").FormatConditions.Delete
    MFC2 "CA", xlThemeColorAccent5
    MFC2 "RTT", xlThemeColorAccent6
    MFC2 "CR", xlThemeColorAccent3
End Sub
Sub MFC2(Texte, Fond)
    With Range("D15:J200")
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=Texte
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.ThemeColor = Fond
    End With
End Sub

 

[dindin]

Ou peut être plus simple, à vous de voir :

Sub Couleur2()
    Range("D15:J200").FormatConditions.Delete
    MFC2 "CA", xlThemeColorAccent5
    MFC2 "RTT", xlThemeColorAccent6
    MFC2 "CR", xlThemeColorAccent3
End Sub
Sub MFC2(Texte, Fond)
    With Range("D15:J200")
        .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, Formula1:=Texte
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        .FormatConditions(1).Interior.ThemeColor = Fond
    End With
End Sub

Bonjour sylvanu,
Merci beaucoup

 

[Staple1600]

Bonjour le fil

Une autre syntaxe posssible

Sub test()
MFC_3 Range("D15:J20")
End Sub

Private Function MFC_3(Rng As Range)
Dim c
c = Array(Array("CA", 3), Array("RTT", 6), Array("CR", 12))
Rng.FormatConditions.Delete
For i = LBound(c) To UBound(c)
Rng.FormatConditions.Add Type:=1, Operator:=3, Formula1:=c(i)(0)
Rng.FormatConditions(i + 1).Interior.ColorIndex = c(i)(1)
Next
End Function

Faire les adaptations nécessaires pour Excel 2016.
(Car test effectué sur Excel 2003 et Excel 2003 ne connait pas cette syntaxe xlThemeColorAccent5)

@sylvanu
Si tu as le temps et la gentilesse de faire la transcription et le test sur un Excel plus récent, merci

 

[dindin]

Bonjour le fil

Une autre syntaxe posssible

Sub test()
MFC_3 Range("D15:J20")
End Sub

Private Function MFC_3(Rng As Range)
Dim c
c = Array(Array("CA", 3), Array("RTT", 6), Array("CR", 12))
Rng.FormatConditions.Delete
For i = LBound(c) To UBound(c)
Rng.FormatConditions.Add Type:=1, Operator:=3, Formula1:=c(i)(0)
Rng.FormatConditions(i + 1).Interior.ColorIndex = c(i)(1)
Next
End Function

Faire les adaptations nécessaires pour Excel 2016.
(Car test effectué sur Excel 2003 et Excel 2003 ne connait pas cette syntaxe xlThemeColorAccent5)

@sylvanu
Si tu as le temps et la gentilesse de faire la transcription et le test sur un Excel plus récent, merci

Encore merci @Staple1600

 

[Staple1600]

Re

@dindin
Tu as pu faire les adaptations nécessaires pour Excel 2016 ?
Au niveau de Interior.ThemeColor

 

[Staple1600]

Re

@dindin
J'ai fait l'adaptation en me basant sur les infos de Microsoft
(mais pas pu testé)
Je te laisse tester

Sub test_B()
MFC_4 Range("D15:J20")
End Sub

Private Function MFC_4(Rng As Range)
Dim c
c = Array(Array("CA", 9), Array("RTT", 10), Array("CR", 7))
Rng.FormatConditions.Delete
For i = LBound(c) To UBound(c)
Rng.FormatConditions.Add Type:=1, Operator:=3, Formula1:=c(i)(0)
Rng.FormatConditions(i + 1).Interior.ThemeColor = c(i)(1)
Next
End Function

 

[dindin]

Re

@dindin
J'ai fait l'adaptation en me basant sur les infos de Microsoft
(mais pas pu testé)
Je te laisse tester

Sub test_B()
MFC_4 Range("D15:J20")
End Sub

Private Function MFC_4(Rng As Range)
Dim c
c = Array(Array("CA", 9), Array("RTT", 10), Array("CR", 7))
Rng.FormatConditions.Delete
For i = LBound(c) To UBound(c)
Rng.FormatConditions.Add Type:=1, Operator:=3, Formula1:=c(i)(0)
Rng.FormatConditions(i + 1).Interior.ThemeColor = c(i)(1)
Next
End Function

je viens de le tester sur Excel 2016, c'est excellent. Merci