Ligne coloré
Résolu
glorioone
Messages postés
11
Date d'inscription
Statut
Membre
Dernière intervention
-
glorioone Messages postés 11 Date d'inscription Statut Membre Dernière intervention -
glorioone Messages postés 11 Date d'inscription Statut Membre Dernière intervention -
Bonjour,
Pour surligner mes lignes j'utilise les cdes suivantes:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous
If ActivationLigne Then Exit Sub
If Target.Count > 1 Then Exit Sub
If AncAdress <> 0 Then 'remettre en normal
Rows(AncAdress).Interior.ColorIndex = xlNone
Rows(AncAdress).Font.ColorIndex = 0
End If
Target.EntireRow.Font.ColorIndex = 1
Target.EntireRow.Interior.ColorIndex = 6
Target.EntireRow.Interior.Pattern = xlSolid
AncAdress = Target.Row
End Sub
Mais comme j'ai des colonnes de couleurs qd je clique sur une autre ligne la ligne suivante ce surligne comme il faut mais l'acienne redevient blanche alors qu'a l'origine elle etait de couleur.
Pouvez vous m'aider pour recuperer les couleurs d'origine
merci
Pour surligner mes lignes j'utilise les cdes suivantes:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous
If ActivationLigne Then Exit Sub
If Target.Count > 1 Then Exit Sub
If AncAdress <> 0 Then 'remettre en normal
Rows(AncAdress).Interior.ColorIndex = xlNone
Rows(AncAdress).Font.ColorIndex = 0
End If
Target.EntireRow.Font.ColorIndex = 1
Target.EntireRow.Interior.ColorIndex = 6
Target.EntireRow.Interior.Pattern = xlSolid
AncAdress = Target.Row
End Sub
Mais comme j'ai des colonnes de couleurs qd je clique sur une autre ligne la ligne suivante ce surligne comme il faut mais l'acienne redevient blanche alors qu'a l'origine elle etait de couleur.
Pouvez vous m'aider pour recuperer les couleurs d'origine
merci
A voir également:
- Ligne coloré
- Partager photos en ligne - Guide
- Mètre en ligne - Guide
- Aller à la ligne excel - Guide
- Apparaitre hors ligne instagram - Guide
- Formulaire en ligne de meta - Guide
6 réponses
Bonjour,
Et pourtant c'est écrit noir sur blanc....
Ton code :
Essaye :
Après, pour plus de précision, faudra être plus précis dans la demande...
Et pourtant c'est écrit noir sur blanc....
Ton code :
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static AncAdress As Long 'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous If ActivationLigne Then Exit Sub If Target.Count > 1 Then Exit Sub If AncAdress <> 0 Then 'remettre en normal Rows(AncAdress).Interior.ColorIndex = xlNone Rows(AncAdress).Font.ColorIndex = 0 End If Target.EntireRow.Font.ColorIndex = 1 Target.EntireRow.Interior.ColorIndex = 6 Target.EntireRow.Interior.Pattern = xlSolid AncAdress = Target.Row End Sub
Essaye :
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static AncAdress As Long 'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous If ActivationLigne Then Exit Sub If Target.Count > 1 Then Exit Sub 'If AncAdress <> 0 Then 'remettre en normal 'Rows(AncAdress).Interior.ColorIndex = xlNone 'Rows(AncAdress).Font.ColorIndex = 0 'End If Target.EntireRow.Font.ColorIndex = 1 Target.EntireRow.Interior.ColorIndex = 6 Target.EntireRow.Interior.Pattern = xlSolid AncAdress = Target.Row End Sub
Après, pour plus de précision, faudra être plus précis dans la demande...
Bonjour,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
Dim AncBkColor As Long
Dim AncFtColor As Long
If ActivationLigne Then Exit Sub
If Target.Count > 1 Then Exit Sub
If AncAdress <> 0 Then 'remettre en normal
Rows(AncAdress).Interior.ColorIndex = AncBkColor
Rows(AncAdress).Font.ColorIndex = AncFtColor
End If
AncBkColor =Target.Interior.ColorIndex
AncFtColor=Target.Font.ColorIndex
Target.EntireRow.Font.ColorIndex = 1
Target.EntireRow.Interior.ColorIndex = 6
Target.EntireRow.Interior.Pattern = xlSolid
AncAdress = Target.Row
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
Dim AncBkColor As Long
Dim AncFtColor As Long
If ActivationLigne Then Exit Sub
If Target.Count > 1 Then Exit Sub
If AncAdress <> 0 Then 'remettre en normal
Rows(AncAdress).Interior.ColorIndex = AncBkColor
Rows(AncAdress).Font.ColorIndex = AncFtColor
End If
AncBkColor =Target.Interior.ColorIndex
AncFtColor=Target.Font.ColorIndex
Target.EntireRow.Font.ColorIndex = 1
Target.EntireRow.Interior.ColorIndex = 6
Target.EntireRow.Interior.Pattern = xlSolid
AncAdress = Target.Row
End Sub
Essaye ceci :
Option Explicit Dim AncCouleur As Integer Private Sub Worksheet_SelectionChange(ByVal Target As Range) Static AncAdress As Long 'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous If ActivationLigne Then Exit Sub If Target.Count > 1 Then Exit Sub If AncAdress <> 0 Then 'remettre en normal Rows(AncAdress).Interior.ColorIndex = AncCouleur Rows(AncAdress).Font.ColorIndex = 1 End If AncCouleur = Target.Interior.ColorIndex Target.EntireRow.Font.ColorIndex = 1 Target.EntireRow.Interior.ColorIndex = 6 Target.EntireRow.Interior.Pattern = xlSolid AncAdress = Target.Row End Sub
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Essaye :
Code :
Si si cela fonctionne :
https://www.cjoint.com/?BGzqhPSan1D
Ne reste à gérer que la fermeture du classeur.......
Cordialement,
Franck P
Code :
Option Explicit Dim AncCouleur() As Integer Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Col As Integer, i As Integer Static AncAdress As Long 'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous 'If ActivationLigne Then Exit Sub If Target.Count > 1 Then Exit Sub Col = Columns.Count If AncAdress <> 0 Then 'remettre en normal For i = 1 To Col Cells(AncAdress, i).Interior.ColorIndex = AncCouleur(i - 1) Next Rows(AncAdress).Font.ColorIndex = 1 End If ReDim AncCouleur(Col - 1) For i = 1 To Col AncCouleur(i - 1) = Cells(Target.Row, i).Interior.ColorIndex Next Target.EntireRow.Font.ColorIndex = 1 Target.EntireRow.Interior.ColorIndex = 6 Target.EntireRow.Interior.Pattern = xlSolid AncAdress = Target.Row End Sub
Si si cela fonctionne :
https://www.cjoint.com/?BGzqhPSan1D
Ne reste à gérer que la fermeture du classeur.......
Cordialement,
Franck P
Bon ça m'apprendra à mieux lire les questions... A ma décharge, il est vrai que la macro de départ était trompeuse.
Bon pour parfaire le fichier voici ce qu'il faut :
Dans le module de la feuille "colorée" dans l'exemple il s'agit de la feuille nommée "Feuil1" :
Ensuite, pour éviter de sauvegarder avec une grosse ligne jaune en plein milieu :
dans le module ThisWorkBook :
Cliquez oui pour enregistrer les modifications lors de chaque fermeture...
LE FICHIER.......
Bon pour parfaire le fichier voici ce qu'il faut :
Dans le module de la feuille "colorée" dans l'exemple il s'agit de la feuille nommée "Feuil1" :
Option Explicit Dim AncCouleur() As Integer Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim Col As Integer, i As Integer Static AncAdress As Long 'Si la fonction activer/Déactiver est implémentée ajouter la ligne ci-dessous 'If ActivationLigne Then Exit Sub If Target.Count > 1 Then Exit Sub Col = Columns.Count If AncAdress <> 0 Then 'remettre en normal For i = 1 To Col Cells(AncAdress, i).Interior.ColorIndex = AncCouleur(i - 1) Next Rows(AncAdress).Font.ColorIndex = 1 End If ReDim AncCouleur(Col - 1) For i = 1 To Col AncCouleur(i - 1) = Cells(Target.Row, i).Interior.ColorIndex Next Target.EntireRow.Font.ColorIndex = 1 Target.EntireRow.Interior.ColorIndex = 6 Target.EntireRow.Interior.Pattern = xlSolid AncAdress = Target.Row End Sub
Ensuite, pour éviter de sauvegarder avec une grosse ligne jaune en plein milieu :
dans le module ThisWorkBook :
Option Explicit Dim CouleursOriginales() As Integer Private Sub Workbook_BeforeClose(Cancel As Boolean) Sheets("Feuil2").Select End Sub Private Sub Workbook_Open() Sheets("Feuil2").Select End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i As Integer, Col As Integer If Sh.Name = "Feuil1" Then Col = Columns.Count ReDim CouleursOriginales(Col) For i = 1 To Col CouleursOriginales(i - 1) = Cells(1, i).Interior.ColorIndex Next i End If End Sub Private Sub Workbook_SheetDeactivate(ByVal Sh As Object) Dim i As Integer, Col As Integer If Sh.Name = "Feuil1" Then With Sh Col = .Columns.Count For i = 1 To Col .Columns(i).Interior.ColorIndex = CouleursOriginales(i - 1) Next i End With End If End Sub
Cliquez oui pour enregistrer les modifications lors de chaque fermeture...
LE FICHIER.......
ensuite, je clique donc sur une ligne, celle-ci prends la couleur jaune, parfais
, je reclique sur une autre ligne, l'autre ligne devient jaune, mais la premiere redevient blanche, c 'est la que le bas blesse car j'ai des colonnes de couleur du coup les lignes ou j'ai cliqué et declique devienne blanche, mon tableau est donc zebré de bande blanche !!!
jespere que j'ai été clair
Merci encore pour votre réponse
Brice
As tu essayé le code donné ici :
https://forums.commentcamarche.net/forum/affich-25665235-ligne-colore#1
Juste en dessous du mot : Essaye :
merci qd meme
brice
Je viens de comprendre.....
Tu as un "tableau" coloré. Tu veux qu'excel se rappelle des couleurs d'origine?
je m'excuse alors.