XL 2019 SURLIGNAGE LIGNE

bambi

XLDnaute Occasionnel
Bonjour

J'ai adapté une macro de surlignage trouvée sur ce forum
Le surlignage est actif sur la ligne selectionnée afin de la mettre en valeur
Je surligne de la ligne 23 à la colonne 40
Mais j'ai des données formatées au-dessus de la ligne 23
Et cette macro supprime TOUT le formatage de la feuille
Est-il possible de conserver la mise en forme au dessus de la ligne 23 ?

Voici ma macro et un classeur exemple

Merci de votre aide

VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
    If Target.Row < 23 Or Target.Column > 41 Then Exit Sub
    If ActivationLigne Then Exit Sub
    If Target.Count > 1 Then Exit Sub
    If AncAdress <> 0 Then 'remettre en normal
        Rows.Interior.ColorIndex = xlNone
        Rows.Font.ColorIndex = 0
      
    End If
    
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Font.ColorIndex = 1
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.ColorIndex = 19
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.Pattern = xlSolid

      AncAdress = Target.Row
  
End Sub
 

Pièces jointes

  • Classeur1.xlsm
    38.8 KB · Affichages: 7
Solution
Bonjour,

Ceci:
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
    If Target.Row < 23 Or Target.Column > 41 Then Exit Sub
    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
    
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Font.ColorIndex = 1
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.ColorIndex = 19
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.Pattern = xlSolid
    AncAdress = Target.Row
End Sub

Cdlt

Rouge

XLDnaute Impliqué
Bonjour,

Ceci:
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static AncAdress As Long
    If Target.Row < 23 Or Target.Column > 41 Then Exit Sub
    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
    
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Font.ColorIndex = 1
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.ColorIndex = 19
    Range(Cells(Target.Row, 1), Cells(Target.Row, 40)).Interior.Pattern = xlSolid
    AncAdress = Target.Row
End Sub

Cdlt
 

Discussions similaires

Réponses
2
Affichages
475