XL 2016 simplifier une macro enregistrée

dindin · 11 Avril 2023

Bonjour,
Comment faire pour simplifier cette macro enregistrée

VB:

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 · 11 Avril 2023

Bonsoir Dinidin,
A essayer :

VB:

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 :

Code:

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

sylvanu · 11 Avril 2023

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

VB:

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 · 12 Avril 2023

sylvanu à dit:

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

VB:

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 · 12 Avril 2023

Bonjour le fil

Une autre syntaxe posssible

VB:

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 · 12 Avril 2023

Staple1600 à dit:
Bonjour le fil

Une autre syntaxe posssible

VB:

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 · 12 Avril 2023

Re

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

Staple1600 · 12 Avril 2023

Re

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

VB:

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 · 12 Avril 2023

Staple1600 à dit:
Re

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

VB:

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

XL 2016 simplifier une macro enregistrée

dindin

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

sylvanu

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

dindin

XLDnaute Occasionnel

Discussions similaires