Ligne après ligne

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
C

cheyenne63

XLDnaute Occasionnel
Bonsoir
Dans un fichier du type de celui en pièce jointe, mes collègues se positionnent dans la colonne L et vérifient les données ligne après ligne (et changent une donnée si besoin) en se déplaçant avec la flèche de défilement du clavier.
Afin de faciliter la visibilité du tableau et qu'ils ne s'arrachent pas les yeux, je souhaiterai que la ligne change momentanément de mise en forme à chaque fois qu'on est positionné sur cette ligne, et ainsi de suite.
Exemple en feuille 2 sur la ligne 13 : mon collègue se positionne en L13, vérifie la ligne (et change si besoin) puis passe en L14 : la police redevient normale sur la 13 et change sur la 14, etc…
Merci d'avance
 

Pièces jointes

Trier par date Trier par votes
Re : Ligne après ligne

Bonsoir cheyenne63,

Ce genre de gadget à sûrement été traité maintes fois sur XLD.

Dans le code de la feuille concernée :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With Rows("5:" & Rows.Count) 'RAZ
  .Interior.ColorIndex = xlNone
  .Font.Bold = False
  .Font.ColorIndex = xlAutomatic
End With
If Not Intersect(ActiveCell, Range("L5", Range("L" & Rows.Count))) Is Nothing Then
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
End Sub
Fichier joint.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Bonjour,
Et dans le cas où il y a dans ce même tableau quelques lignes avec un contenu et une mise en forme différente des autres ?
Vu les codes dans module1 et dans feuil2, ces lignes particulières ne se distingent plus des autres, et c'est assez problématique ...
Voir fichier joint avec ces nouvelles cellules en gris.
Merci
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Bonjour cheyenne63,

Comme je l'ai dit c'est un gadget alors faut pas exagérer les choses.

Mais on peut toujours mémoriser le format d'une ligne entière :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Byte
If [A1] > 0 Then
  With Cells([A1], 1).Resize(, 11)
    .Interior.Color = [B1].Interior.Color
    .Font.Bold = [B1].Font.Bold
    .Font.Color = [B1].Font.Color
  End With
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing Then
  [A1] = ActiveCell.Row 'mémorise la ligne
  Cells(ActiveCell.Row, 1).Copy [B1] 'pour mémoriser le format
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
End Sub
Fichier (2)

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Re,

On aura remarqué qu'avec les versions précédentes le Copier-Coller est impossible.

Cette version (3) le permet :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Byte
If [A1] > 0 Then
  With Cells([A1], 1).Resize(, 11)
    .Interior.ColorIndex = [B1].Interior.ColorIndex
    .Font.Bold = [B1].Font.Bold
    .Font.Color = [B1].Font.Color
  End With
  [A1] = "" 'RAZ (permet le Copier-Coller)
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing Then
  [A1] = ActiveCell.Row 'mémorise la ligne
  Cells(ActiveCell.Row, 1).Copy [B1] 'pour mémoriser le format
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
End Sub
Noter que .Interior.ColorIndex va mieux que .Interior.Color.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Re,

S'il y a des cellules isolées qui sont colorées on peut ne pas formater la ligne :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Byte
If [A1] > 0 Then
  With Cells([A1], 1).Resize(, 11)
    .Interior.ColorIndex = [B1].Interior.ColorIndex
    .Font.Bold = [B1].Font.Bold
    .Font.Color = [B1].Font.Color
  End With
  [A1] = "" 'RAZ (permet le Copier-Coller)
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing _
  And Not IsNull(Cells(ActiveCell.Row, 1).Resize(, 11).Interior.ColorIndex) Then
  [A1] = ActiveCell.Row 'mémorise la ligne
  Cells(ActiveCell.Row, 1).Copy [B1] 'pour mémoriser le format
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
End Sub
Fichier (4).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Re,

Bon voilà qui est beaucoup mieux, j'aurai dû le faire tout de suite :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim c As Range
Application.EnableEvents = False 'désactive les événements
If [L1] > 0 Then
  Application.ScreenUpdating = False
  Set c = ActiveCell
  [A1:K1].Copy
  Cells([L1], 1).PasteSpecial xlPasteFormats 'collage spécial formats
  c.Select
  [L1] = "" 'RAZ (permet le Copier-Coller)
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing Then
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Copy [A1] 'pour mémoriser les formats
    [L1] = ActiveCell.Row 'mémorise la ligne
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
Application.EnableEvents = True 'réactive les événements
End Sub
Les cellules d'une ligne peuvent être formatées comme on veut, tout est mémorisé.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : [Résolu] Ligne après ligne

Re
De mieux en mieux ...
C'est ce que j'essayais (en vain) de faire depuis 2 bonnes heures 😉
J'ai compris et je viens d'adapter le code et ça marche nickel.
Un petit détail : pour les utilisateurs ce n'est pas un gadget car sur le fichier d'origine c'était vraiment nécessaire de mettre la ligne à traiter en valeur.
Le premier collègue directement concerné et qui vient de tester t'en remercie vivement.
Merci de t'être penché sur ce cas et bien sûr de l'avoir résolu.
Bonne journée
 
Vote positif 0 Vote négatif
Re : Ligne après ligne

Re,

Application.ScreenUpdating a l'inconvénient de créer des sauts d'écran.

Ceci l'évite :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Byte, tablo(1 To 11)
Application.EnableEvents = False 'désactive les événements
If [L1] Then
  For i = 1 To 11 'mémorisation des formules
    tablo(i) = Cells([L1], i).Formula
  Next
  [A1:K1].Copy Cells([L1], 1)
  Cells([L1], 1).Resize(, 11) = tablo
  [L1] = "" 'RAZ (permet le Copier-Coller)
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing Then
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Copy [A1] 'pour mémoriser les formats
    [L1] = ActiveCell.Row 'mémorise la ligne
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
Application.EnableEvents = True 'réactive les événements
End Sub
Fichier (6).

Je pense qu'on a maintenant fait le tour de la question.

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Re : Ligne après ligne

Re,

Bah non ce n'était pas fini, le must c'est ceci :

Code: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim tablo
Application.EnableEvents = False 'désactive les événements
If [L1] Then
  tablo = Cells([L1], 1).Resize(, 11).Formula 'mémorise les formules
  [A1:K1].Copy Cells([L1], 1)
  Cells([L1], 1).Resize(, 11) = tablo
  [L1] = "" 'RAZ (permet le Copier-Coller)
End If
If Not Intersect(ActiveCell, Range("L6", Range("L" & Rows.Count))) Is Nothing Then
  With Cells(ActiveCell.Row, 1).Resize(, 11)
    .Copy [A1] 'pour mémoriser les formats
    [L1] = ActiveCell.Row 'mémorise le n° de ligne
    .Interior.ColorIndex = 6 'jaune
    .Font.Bold = True 'gras
    .Font.ColorIndex = 3 'rouge
  End With
End If
Application.EnableEvents = True 'réactive les événements
End Sub
Fichier (7).

A+
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
XL 2013 Copier-Coller une ligne dans tableau variable, et la manipuler.
Réponses
4
Affichages
375
StéphaneDeLà
S
L
  • Résolu(e)
XL 2016 MFC sur plusieurs critères
2 3 4
Réponses
55
Affichages
3 K
Lorenzini
L
M
  • Question Question
Microsoft 365 N'afficher que la dernière ligne d'un tableau dans listbox
Réponses
9
Affichages
961
meyscal
M
L
  • Question Question
XL 2016 Calcul à partir d'une date précise ou - à défaut - à partir de la date qui suit immédiatement après
Réponses
4
Affichages
820
Lorenzini
L
T
  • Question Question
XL 2016 Résolu - Copier une ligne d'un tableau en modifiant la feuille source
Réponses
6
Affichages
1 K
Tamazkiel
T
A
  • Résolu(e)
XL 2016 Décompte de valeurs précises avec bornage
Réponses
11
Affichages
2 K
albuqs
A
M
  • Résolu(e)
XL 2016 VBA MsgBox si dernière ligne atteinte
Réponses
7
Affichages
2 K
M'uru
M
C
  • Question Question
XL 2013 Ajustement de la barre de défilement de droite
Réponses
3
Affichages
7 K
JejeBaa
J
P
  • Question Question
XL 2010 Compléter feuille en fonction d une autre feuille sélectionné par liste déroulante.
Réponses
6
Affichages
2 K
Popeye67
P
C
  • Question Question
Microsoft 365 problème navigation et selection dans Combobox-Liste de choix
Réponses
4
Affichages
2 K
chostra
C
D
  • Question Question
Microsoft 365 Formule / VBA tableau : nom de ligne et délais par créneau
Réponses
6
Affichages
2 K
njhub
N
J
  • Question Question
XL 2016 Colorer une ligne sur deux + Numérotation automatique
Réponses
2
Affichages
676
jorge1201
J
G
  • Question Question
XL 2013 Figer les valeurs après macro
Réponses
3
Affichages
2 K
danielco
D
B
  • Question Question
XL 2013 [VBA] Extraction de données basé sur 2 à 3 conditions
Réponses
2
Affichages
2 K
bastienb
B
N
  • Résolu(e)
Microsoft 365 problème de boucle VBA
Réponses
3
Affichages
1 K
ninajams
N
F
  • Question Question
suppréssion de ligne
Réponses
13
Affichages
2 K
faguer
F
M
  • Question Question
Macro compliqué pour moi
Réponses
4
Affichages
1 K
meldja
M
donpopo
  • Question Question
En VBA, couper une ligne et la copier plus bas à un endroit précis
Réponses
8
Affichages
4 K
donpopo
donpopo
B
  • Question Question
Erreur d'exécution 13
Réponses
1
Affichages
712
bluet
B
S
  • Question Question
XL 2016 Pousser les données de l'Userform dans une nouvelle ligne de tableau
Réponses
8
Affichages
2 K
Sparfell29
S
Retour