Mettre une ligne sur deux en couleur

Version imprimable

27/09/2019, 09h59
jean30

Mettre une ligne sur deux en couleur
Bonjour chers amis
Je viens de trouver sur ce lien :
https://www.developpez.net/forums/d6...lage-cellules/

Ce code de laetitia :
Code:

1 2 3 4 Sub essai5() Dim i As Long, x As Long i = 1: For x = 1 To 5: Range(Cells(i, 1), Cells(i, 26)).Interior.ColorIndex = 3: i = i + 2: Next End Sub
Que faut-il modifier pour que la coloration commence à la ligne 3 jusqu'à la dernière ligne non vide
En vous remerciant

A tester:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Sub couleur()
 
Dligne = Range("A60000").End(xlUp).Row
 
 
For A = 3 To Dligne Step 2
Rows(A).Interior.ColorIndex = 3
 
Next A
 
 
End Sub

Edit:

Deuxième version du code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub couleur()
 
Dligne = Range("A60000").End(xlUp).Row
Dcolonne = Range("ZZ1").End(xlToLeft).Column
 
 
For A = 3 To Dligne Step 2
Cells(A, 1).Rows.Interior.ColorIndex = 3
For B = 1 To Dcolonne Step 1
 
Cells(A, B).Interior.ColorIndex = 3
 
Next B
Next A
 
 
End Sub

Celui-ci s'adapte automatiquement au nombre de colonne. La première version coloriait toute la ligne (désolé).

Bon courage !

27/09/2019, 11h52
Menhir

Plus simple : mettre sur la liste une mise en forme conditionnelle avec une formule =MOD(LIGNE();2)=0.

Encore plus simple : transformer la liste en tableau structuré : Ruban Insertion > Icone Tableau.
27/09/2019, 12h19
MarcelG

Télescopage.
Si un modérateur est présent, je vais le contacter.

Bonjour le Forum,
(désolé pour mon absence)

Bonjour à vous,

Sans VBA.
Au préalable, affecter le même format à toutes les cellules
Dans un deuxième temps, une mise en forme conditionnelle basée sur une formule contenant le n° de ligne aurait suffi
27/09/2019, 12h40
jean30

Bonjour à chacun,
Merci de me répondre.

Mickamax :
Le premier code fonctionne mais pas le second.
J'aurai également du demander comment limiter l'action a la plage A:AG

Bonjour Jean,

Chez moi le deuxième code fonctionne :)

Essayez comme-ceci, j'avais oublié d'enlever une ligne:
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub couleur() Dligne = Range("A60000").End(xlUp).Row Dcolonne = Range("ZZ1").End(xlToLeft).Column For A = 3 To Dligne Step 2 For B = 1 To Dcolonne Step 1 Cells(A, B).Interior.ColorIndex = 3 Next B Next A End Sub
Tenez moi au courant.

Cela dit, la solution préconisée par @Menhir est plus simple et a le mérite de se mettre à jour automatiquement ;)

27/09/2019, 13h32
jean30

Oui le code fonctionne, merci bien
Mais comment limiter l'action a la plage A:AG jusqu'à la dernière ligne non vide
27/09/2019, 14h49
Mickamax

@Jean 30,

La boucle est bornée par deux fois (pour le deuxième code que je vous ai envoyé):

Une fois par les lignes grâce à la variable Dligne qui va automatiquement chercher (via XlUp) la dernière ligne non vide, et une fois par les colonnes grâce à la variable Dcolonne qui va automatiquement chercher (Via XlToLeft) la dernière colonne non vide.

Le code va ensuite (en partant de la troisième ligne) colorier toutes les cellules dans cette boucle (bornée, donc) en faisant des sauts de 2 lignes (grâce à step 2).

Vous pouvez m'envoyer votre fichier si vous le souhaitez.

Je reste dispo.
27/09/2019, 18h08
Menhir

Citation:

Envoyé par jean30

J'aurai également du demander comment limiter l'action a la plage A:AG

En appliquant la MFC qu'à la plage A:AG.

Visiblement, tu ne maitrises pas le VBA.
Il serait donc préférable pour toi de t'en tenir à des solutions traditionnelles.

Citation:

Envoyé par Menhir

En appliquant la MFC qu'à la plage A:AG.

Visiblement, tu ne maitrises pas le VBA.
Il serait donc préférable pour toi de t'en tenir à des solutions traditionnelles.

Je ne peu pas utiliser les MFC, tu vas comprendre pourquoi j'espère.

Bonjour Menhir
J'apprécie ton acharnement à m'aider et je t'en remercie car c'est très dur pour moi et tu sais pourquoi. Et il est vrai que je ne maitrise pas le Vba.
Ce que je voudrais c'est que les codes s'appliquent de la colonne A à la colonne AB et sur un nombre de lignes variables pour les deux codes.
Sans que cela modifie ou change la couleur de la ligne des titres.
Je mets les trois codes concernés ci-dessous comptant sur votre connaissance et votre solution à mon problème.

Code sur Feuille1
'Colorer ligne active en jaune si clic en (colonne "A" ou "B"). Plage de A:AB et jq la dernière ligne non vide en jaune clair, ce qui supprime la coloration une ligne sur deux en vert clair.
'Tous clics dans les autres cellules, colonne C:AB sans effet, mais permettant l'écriture et correction.
Code:

1 2 3 4 5 6 7 8 9 Private Sub Worksheet_SelectionChange(ByVal Target As Range) Application.ScreenUpdating = False 'annulation de la Mfc, mais il ne devrait pas y en avoir car incompatible avec le code précédent[/INDENT][/COLOR][/COLOR] Selection.FormatConditions.Delete 'annulation de la Mfc, mais il ne devrait pas y en avoir car incompatible avec le code précédent If Target.Cells.Column > 2 Then Exit Sub Cells.Interior.ColorIndex = xlNone Target.EntireRow.Interior.ColorIndex = 36 'jaune clair (ligne active) Application.ScreenUpdating = True End Sub
Code:

1 2 3 4 5 6 7 8 9 10 11 12 Private Sub Worksheet_Activate() 'Faliciter lecture, recherche et impression de la feuille. Application.ScreenUpdating = True Dim MaPlage As Range Call EffCouleur Dligne = Range("A500").End(xlUp).Row 'idéalement les colonnes A:AB et jq dernière ligne non vide For A = 3 To Dligne Step 2 Rows(A).Interior.ColorIndex = 35 'vert clair Next A Range("C3").Select Application.ScreenUpdating = False End Sub
Module1
Code:

1 2 3 4 5 6 7 8 Sub EffCouleur() Application.ScreenUpdating = False 'de A:AB et jq dernière ligne non vide With Selection.Interior .Pattern = xlNone End With Application.ScreenUpdating = True End Sub
En espérant être compris car épuisé.
Je vous remercie de tout cœur.

Si besoin : https://www.cjoint.com/c/IIBtfrUBdma

28/09/2019, 09h43
jean30

Menhir
Dans cette discussion tu dis :
https://www.developpez.net/forums/d2...-selectionnee/
Ça ne servirait à rien puisque la MFC surpasserait la mise en forme, même si elle est remise après.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Dim Dligne As Long
Dim MaPlage As Range
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Plage As Range
    Application.ScreenUpdating = False
    If Target.Cells.Column > 2 Then Exit Sub
        EffCouleur
    Set Plage = Application.Intersect(MaPlage, Rows(Target.Row))
        If Not Plage Is Nothing Then
           Plage.Interior.ColorIndex = 36 '(jaune clair) de colonne A:AB et jq derniere ligne non vide
        End If
    Application.ScreenUpdating = True
End Sub
 
Private Sub Worksheet_Activate()
    Application.ScreenUpdating = True
        EffCouleur
    Application.ScreenUpdating = False
End Sub