ligne coloré Résolu

Question

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

pijaku · Answer

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

tuxboy · Answer

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

pijaku · Answer

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

glorioone · Answer

Je suis désolé mais cela ne fonctionne pas !

merci

pijaku · Answer

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

pijaku · Answer

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

Ligne coloré

6 réponses

Discussions similaires

Newsletters