Ligne coloré
Résolu
glorioone
Messages postés
11
Statut
Membre
-
glorioone Messages postés 11 Statut Membre -
glorioone Messages postés 11 Statut Membre -
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
- Formulaire en ligne de meta - Guide
- Apparaitre hors ligne instagram - Guide
- Aller à la ligne excel - 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.