Private sub (MEF borders) : pb après un tri.

[zebanx]

Bonjour à tous,

Un petit code en private sub me permet d'afficher une bordure (xlTOP) si le numéro de facture est différent (clé : colonne C).

Mais si j'ai besoin de trier, par exemple sur le code client.... il n'y a pas de rafraichissement permettant de conserver les bordures suivant le numéro de facture.

Pourriez-vous svp m'apporter votre aide pour modifier ce code ?

Vous en remerciant, bonne journée
zebanx

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&
' If Not Application.Intersect(Target, Range("F" & Target.Row)) Is Nothing Then
    lastc = Cells(1, Columns.Count).End(1).Column
    Set plage = Range(Cells(Target.Row, 1), Cells(Target.Row, lastc))
    If (Cells(Target.Row, 3) <> Cells(Target.Row - 1, 3) And Cells(Target.Row, 3) <> "") Then
    With plage.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Else
    plage.Borders(xlEdgeTop).LineStyle = xlNone
    plage.Borders(xlEdgeBottom).LineStyle = xlNone
    'plage.Borders.LineStyle = xlNone
    End If
'End If
End Sub

 

[Staple1600]

Bonjour le fil,

zebank
Juste pour infos
Avec cette petite modif "réductrice", le résultat est le même qu'avec le code initial, non?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lg&, lastc&
' If Not Application.Intersect(Target, Range("F" & Target.Row)) Is Nothing Then
lastc = Cells(1, Columns.Count).End(1).Column
Set plage = Range(Cells(Target.Row, 1), Cells(Target.Row, lastc))
If (Cells(Target.Row, 3) <> Cells(Target.Row - 1, 3) And Cells(Target.Row, 3) <> "") Then
plage.Borders(xlEdgeTop).Weight = xlMedium
Else
plage.Borders(xlEdgeTop).LineStyle = xlNone
plage.Borders(xlEdgeBottom).LineStyle = xlNone
'plage.Borders.LineStyle = xlNone
End If
'End If
End Sub

 

[zebanx]

Bonjour Staple1600,

Exact. Je te remercie pour cette première purge