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   -
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

6 réponses

pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour,

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...
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Merci pour cette réponse mais je vais essayé d'etre plus clair, pour commencer, je suis un débutant,
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
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Bonjour, <-- Si si c'est important! Chaque matin oui...

As tu essayé le code donné ici :
https://forums.commentcamarche.net/forum/affich-25665235-ligne-colore#1

Juste en dessous du mot : Essaye :
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Malheureusement la ligne reste jaune une fois que j'ai cliqué sur une autre ligne !!

merci qd meme

brice
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Alors tu t'es très mal exprimé!
Je viens de comprendre.....
Tu as un "tableau" coloré. Tu veux qu'excel se rappelle des couleurs d'origine?
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Oui c 'est tout à fait ca !!!
je m'excuse alors.
0
tuxboy Messages postés 995 Date d'inscription   Statut Membre Dernière intervention   190
 
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
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Ca ne change rien mais merci quand meme

brice
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
Je suis désolé mais cela ne fonctionne pas !

merci
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Je suis désolé alors.

Passe nous ton fichier grâce à : https://www.cjoint.com/
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
pas si tu colores les colonnes !!!
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
pas si tu colores les colonnes !!!
1- c'est nouveau non dans la discussion???
0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
non, j'en ai parlé à 11h40 ....
mais c pas grave l'essentiel est de s'en apercevoir
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
Essaye :
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
0
pijaku Messages postés 12263 Date d'inscription   Statut Modérateur Dernière intervention   2 761
 
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" :
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.......


0
glorioone Messages postés 11 Date d'inscription   Statut Membre Dernière intervention  
 
merci c cool les gars
0