Microsoft 365 Peut on simplifier ce code ? (Résolu)

Kael_88

XLDnaute Occasionnel
Le forum,

Si cela était possible, je voudrai savoir s'il est possible de simplifier le code suivant et par quoi.
pour résumer, dans un tableau, on colorie les cellules une ligne sur deux en partant des cellules ligne 2
pour les colonnes :
C à F en vert,
G à I en rose pale,
J à K en vert pale,
L à N en bleu pale,
O à P en orange pale,

cordialement

VB:
' Reference centrée
    Rows("3").Select
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

' Couleur colonne
    Range("C4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Range("G4:I4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("J4:K4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("L4:N4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("O4:P4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Range("Q4:R4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.799981688894314
        .PatternTintAndShade = 0
    End With
    Rows("3:4").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, Kael_88

Pour les couleurs, ma façon de faire
VB:
Sub Couleurs()
Dim i, Gribouillage
Range("C4:F4").Interior.Color = 5296274
Gribouillage = Array(Array("G4:I4", 6), Array("J4:K4", 10), Array("L4:N4", 9), Array("O4:P4", 8), Array("Q4:R4", 7))
For i = 0 To 4
With Range(Gribouillage(i)(0)).Interior
.ThemeColor = Gribouillage(i)(1): .TintAndShade = 0.799981688894314
End With
Next
End Sub
PS: Code rédigé et testé avant les ajouts du demandeur dans l'édition du message#1
 

Staple1600

XLDnaute Barbatruc
Re

Une variante "simplifiée" du code précédent, en espérant que j'ai compris la question. ;)
VB:
Sub Couleurs_III()
Dim i, j&, Gribouillage
Gribouillage = Array(Array("G$:I$", 6), Array("J$:K$", 10), Array("L$:N$", 9), Array("O$:P$", 8), Array("Q$:R$", 7))
For i = 3 To 100
If i Mod 2 = 0 Then
Cells(i, 3).Resize(, 4).Interior.Color = 5296274
For j = 0 To 4
With Range(Replace(Gribouillage(j)(0), "$", i)).Interior
.ThemeColor = Gribouillage(j)(1): .TintAndShade = 0.799981688894314
End With
Next j
End If
Next i
End Sub
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonsoir Kael, ReBonsoir Staple
Déjà une simplication, on peut remplacer ça :
VB:
Range("C4:F4").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 5296274
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
par ça :
Code:
Range("C4:F4").Interior.Color = RGB(146, 208, 80)
ou encore par :
Code:
Range("C4:F4").Interior.ColorIndex = 43
si on a choisi dans la table des couleurs. Malheureusement ici, seules 4 sur 6 en sont issues.
Bonsoir tout le monde.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bien le bonjour Kael, Staple,
Staple, 14 lignes se simplifient toujours. Ici en 6 lignes :
VB:
Sub Couleurs_IV()
C = Array(3, 6, 18, 26, 10, 7, 9, 30, 27, 27, 10, 11, 31, 29, 27, 12, 14, 27, 29, 30, 15, 16, 28, 28, 29, 17, 18, 29, 30, 27)
For i = 0 To 29 Step 5
    Range(Cells(3, C(i)), Cells(3, C(i + 1))).Interior.Color = RGB(8 * C(i + 2), 8 * C(i + 3), 8 * C(i + 4))
Next i
End Sub
Mes respects du matin.
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Re Staple,
Bien évidemment, je pourrais vous proposer ça en 4 lignes:
Code:
Sub Couleurs_V()
Range("C4:F4").Interior.Color = RGB(146, 208, 80): Range("G4:I4").Interior.Color = RGB(242, 221, 220): Range("J4:K4").Interior.Color = RGB(253, 233, 217)
Range("L4:N4").Interior.Color = RGB(219, 238, 243): Range("O4:P4").Interior.Color = RGB(229, 224, 236): Range("Q4:R4").Interior.Color = RGB(234, 241, 221)
End Sub
mais vous allez me taxer de mauvaise foi. ;)
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

sylvanu
Dans Couleurs_V, il manque cet aspect de la question non ?
pour résumer, dans un tableau, on colorie les cellules une ligne sur deux en partant des cellules ligne 2
Compléter par ce qu'on peut supputer de
VB:
Rows("3:4").Select
    Selection.Copy
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Pour faire dans la tranche de foi (qui désormais n'est plus uptodate ;))
Pourquoi ne pas ratiboiser plus court ? ;)
[C4:F4].Interior.Color = RGB(146, 208, 80):[G4:I4].Interior.Color = RGB(242, 221, 220) etc...
 

Statistiques des forums

Discussions
311 723
Messages
2 081 934
Membres
101 844
dernier inscrit
pktla