Ligne coloré

Résolu
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

6 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. glorioone Messages postés 11 Statut Membre
       
      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
    3. glorioone Messages postés 11 Statut Membre
       
      Malheureusement la ligne reste jaune une fois que j'ai cliqué sur une autre ligne !!

      merci qd meme

      brice
      0
    4. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
       
      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
    5. glorioone Messages postés 11 Statut Membre
       
      Oui c 'est tout à fait ca !!!
      je m'excuse alors.
      0
  2. tuxboy Messages postés 1083 Statut Membre 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
    1. glorioone Messages postés 11 Statut Membre
       
      Ca ne change rien mais merci quand meme

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

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

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

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

    Posez votre question
  6. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
  7. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    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
    1. glorioone Messages postés 11 Statut Membre
       
      merci c cool les gars
      0

Discussions similaires

Statut « en ligne » alors que non
GgBono -
Slickk -

1 réponse
Ça veut dire quoi "adresse ligne 1" sur les formulaires ?
ryadfa11 -
Wilfried -

17 réponses
Excel : afficher toutes les lignes et colonnes masquées
livlarsen -
Mehdiiii -

27 réponses
IPhone "correspondant occupé"
a_anrt -
jgenie -

13 réponses