Office 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 Impliqué
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 Impliqué
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 Impliqué
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...
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas