XL 2010 Griser une ligne sur deux sur x lignes (Avec un Grand Merci)

misteryann

misteryann

XLDnaute Occasionnel
Bonsoir le Forum.

Je cherchais depuis un moment comment "griser" une ligne sur deux dans un tableau comportant 8 colonnes et x lignes (de 1 à 500 - 600). Mais rien...
Puis je me suis rappeler que l'on pouvait utiliser l'enregistreur de macro.

Les pros du VBA ne s'y tromperont pas et feront plus simple mais si cela peut aider les novices comme moi, tant mieux.

Après quelques tâtonnements et recherche sur l'internet pour connaître la dernière ligne vide ça donne cela :

Sub Macro9()
' en C1 j'ai mis la formule =MAX(SI(NON(ESTVIDE(A1:A1009));LIGNE(A1:A1009))) sous forme matricielle (validation par ctrl +maj+entrée)

Dim DerniereLigne As Integer
DerniereLigne = Range("G" & Sheets("Edition").Cells(1, 3)).End(xlUp).Row

Columns("A:H").Select

'centrage des cellules
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With

Sheets("Edition").Activate
Range("A7:H" & Sheets("Edition").Cells(1, 3)).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$7:H" & Sheets("Edition").Cells(1, 3)), , xlYes).Name = "Tableau12"
Range("Tableau12[#All]").Select
ActiveSheet.ListObjects("Tableau12").TableStyle = "TableStyleLight1"

' dimensionnement des cellules
Columns("A:A").ColumnWidth = 30
Columns("C:C").ColumnWidth = 17
Columns("E:E").ColumnWidth = 26
Columns("D:D").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
End Sub

Mais pour tout avouer, je suis trop content d'avoir "créer" mon premier code en VBA :):):)
Par ailleurs si quelqu'un pouvait se pencher sur mon post sur le diagramme de GANT...

Bien cordialement.
Misteryann
 
Dernière édition:
Trier par date Trier par votes
misteryann

misteryann

XLDnaute Occasionnel
Bonjour Dugenou.
Parce que cette macro fait partie d'une application plus importante dont le but est de minimiser les clics
C'est d'ailleurs en passant par insertion / tableau que je suis arrivé à cette macro
Bonne journée.
Cordialement.
 
Vote positif 0 Vote négatif
misteryann

misteryann

XLDnaute Occasionnel
Bonsoir le forum
Merci Zebanx

En passant, un énorme MERCI à celles et ceux qui m'ont aider pour créer cette appli (et ce n'est pas fini :)), respect pour eux, leur investissement et à celles et ceux qui prennent la peine de répondre à mes posts.

Je profite de ce post pour expliquer le contexte.

Je connais cette MFC (celle de Zebanx).
Mais le problème de celle-ci est qu'elle colore une plage fixe.
Or ma plage est variable en fonction du nombre de lignes (on peut aussi adapter le code en fonction du nombre de colonnes).
D'ailleurs, je ne vois pas l'intérêt de cette MFC puisque mettre sous forme de tableau est bien plus rapide...

Bref, mon fichier Excel de travail comporte une trentaine de feuilles et d'USF avec des cases à cocher, options, combo, list, etc. afin de remplir des Bases de Données et ainsi de gérer des devis, commandes, interventions, actions de maintenance.
Ce qui me prenait 10 mn avant me prend 2 mn maintenant...
Le but est de travailler un max sur les USF sans passer par les menus d'Excel.
C'est pour cela que je veux automatiser certaines tâches.

Dans le cas présent, un tableau de 10 lignes est simple à suivre mais quand celui-ci en comporte 500 cela devient difficile à suivre (vive la règle en plastique dans ces cas là...)
Alors je trouvais dommage de bloquer sur une simple mise en page que j'arrivais à faire sous Excel mais pas en VBA.

Un grand Merci aussi aux admins d' Excel-Download qui propose de poster des pièces jointes, ce qui facilite les progrès de chacun d'entre nous.

Bien cordialement.
Misteryann
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

Histoire de sortir du gris, pour se griser (enfin si peu) de couleurs ;)
Une macro paramétrable au niveau des lignes et des couleurs
A tester sur une feuille VIDE.
(lancer Test_I ou Test_II)
VB: 
Sub Test_I()
Cells.Clear
'ici on alterne 1 ligne sur 2
Alternative_Coloree Range("A1:A100"), 2, ColorConstants.vbMagenta
End Sub
Sub Test_II()
Cells.Clear
'ici on alterne 1 ligne sur 5
Alternative_Coloree Range("A1:A100"), 5, ColorConstants.vbYellow
End Sub
Private Sub Alternative_Coloree(R As Range, Intervalle As Long, Couleur)
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = R.Rows.Count
For i = Intervalle To LR Step Intervalle
Rows(i).EntireRow.Interior.Color = Couleur
Next i
Application.ScreenUpdating = True
End Sub
 
Vote positif 0 Vote négatif
M

Mexav

XLDnaute Nouveau
phlaurent55 à dit:
Re,

le même fichier avec lignes alternant deux couleurs

à+
Philippe
Cliquez pour agrandir...
Bonsoir et merci beaucoup pour ce tuto et les classeurs Excel accompagnant.
Cela fonctionne correctement, cependant j'aurais voulu alterner les deux couleurs dans les colonnes ("A1:E") et les colonnes ("L1:Q"), j'ai essayé, mais il me manque encore un coup de pouce !
Voir le fichier et le code
Merci d'avance pour votre aide.
Mexav
 

Pièces jointes

  • 111 _3 couleurs(1).xlsm
    15.4 KB · Affichages: 8
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Bonsoir.
1611620659246.png

Mais personnellement je préfère mettre mes plages sous forme de tableaux: c'est automatique.

Ah, je n'avais pas vu la macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim FCn As FormatCondition
   If Not Intersect(Target, Range("A:A")) Is Nothing Then
      Cells.FormatConditions.Delete
      Intersect([A:E,L:Q], [1:1].Resize([A65535].End(xlUp).Row)).Select
      Set FCn = Selection.FormatConditions.Add(Type:=xlExpression, _
         Formula1:="=MOD(LIGNE(A1);2)")
      With FCn.Interior
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = -0.14996795556505
         End With
      FCn.StopIfTrue = False
      Set FCn = Selection.FormatConditions.Add(Type:=xlExpression, _
         Formula1:="=MOD(LIGNE(A1)+1;2)")
      With FCn.Interior
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorAccent6
         .TintAndShade = 0.599963377788629
         End With
      FCn.StopIfTrue = False
      End If
   [A1].Select
   End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
M

Mexav

XLDnaute Nouveau
Dranreb à dit:
Bonsoir.
Regarde la pièce jointe 1092977
Mais personnellement je préfère mettre mes plages sous forme de tableaux: c'est automatique.

Ah, je n'avais pas vu la macro :
VB: 
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim FCn As FormatCondition
   If Not Intersect(Target, Range("A:A")) Is Nothing Then
      Cells.FormatConditions.Delete
      Intersect([A:E,L:Q], [1:1].Resize([A65535].End(xlUp).Row)).Select
      Set FCn = Selection.FormatConditions.Add(Type:=xlExpression, _
         Formula1:="=MOD(LIGNE(A1);2)")
      With FCn.Interior
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = -0.14996795556505
         End With
      FCn.StopIfTrue = False
      Set FCn = Selection.FormatConditions.Add(Type:=xlExpression, _
         Formula1:="=MOD(LIGNE(A1)+1;2)")
      With FCn.Interior
         .PatternColorIndex = xlAutomatic
         .ThemeColor = xlThemeColorAccent6
         .TintAndShade = 0.599963377788629
         End With
      FCn.StopIfTrue = False
      End If
   [A1].Select
   End Sub
Cliquez pour agrandir...
Merci Dranreb pour cette réponse aussi rapide et qui fonctionne.
Ben oui, il y a toujours un "cependant ou un mais", les mêmes couleurs sont appliquées aux deux blocs de lignes, je voudrais utiliser un autre bicolore pour le 2me bloc soit [L:Q]
Je suppose qu'il faut écrire distinctement un code pour [A;E] et un autre pour [L:Q]
Je vais tenter, sinon je referai appel.
A bientôt pour la suite, bonne journée.
Mexav
 
Vote positif 0 Vote négatif
Dranreb

Dranreb

XLDnaute Barbatruc
Il suffit normalement de changer le Select :
VB: 
Intersect([A:E,L:Q], [6:6].Resize([A65535].End(xlUp).Row - 5)).Select
ou pour des blocs séparés pour des couleurs différentes c'est plus simple :
VB: 
[A6:E6].Resize([A65535].End(xlUp).Row - 5)).Select
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Autres bug sur une procédure avec textbox contenant un code barre
2
Réponses
15
Affichages
624
TooFatBoy
TooFatBoy
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
Ferbank
  • Question
XL 2019 modifier une macro
Réponses
2
Affichages
734
Ferbank
Ferbank
M
  • Question
XL 2013 Envoyer un mail automatique avec le contenu de la bonne ligne
Réponses
2
Affichages
638
Oneida
Oneida
A
  • Résolu(e)
XL 2019 Passage de 2013 pro à 2019 pro, Pb avec formule VBA, liens hypertexte
2 3 4
Réponses
54
Affichages
2 K
sylvanu
sylvanu
K
  • Résolu(e)
XL 2019 Copier Seulement les lignes affichée après un filtre de tableau
Réponses
9
Affichages
1 K
Kushi
K
GADENSEB
  • Question
Microsoft 365 Soucis boucle pour Compléter deux datas base avec un seul usf
Réponses
1
Affichages
479
GADENSEB
GADENSEB
D
  • Question
Microsoft 365 vba - appliquer un formula local sur une plage filtrée
Réponses
2
Affichages
412
douguy
D
P
  • Question
Autres Copier une ligne sous conditions ainsi que celles qui suivent
Réponses
0
Affichages
638
Pépito095
P
L
  • Question
XL 2016 Insertion lignes + Copie formules ligne du dessous/dessus sur deux feuilles
Réponses
1
Affichages
708
lilidxb
L

Membres actuellement en ligne

Aucun membre en ligne actuellement.
2 membres et 53 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 105
Messages
2 085 350
Membres
102 870
dernier inscrit
Armisa