XL 2019 Rendre fixe pr rapport à l'écran les segments

' Contenant du segment sur la feuille
Dim SegmentShape As Shape

Private Sub SetSegmentShape()
'
' Tenter de récupérer le Shape nommé "Saison"
' pour initialiser l'objet 'SegmentShape'
    On Error Resume Next
    Set SegmentShape = Me.Shapes("Saison")
    On Error GoTo 0
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    '
    ' Si SegmentShape n'est pas initialisé
    ' tenter de le récupérer et l'initialiser
    If SegmentShape Is Nothing Then SetSegmentShape
    '
    ' S'il n'est toujours pas initialisé (Pas trouvé sur la feuille ?)
    ' alors sortir
    If SegmentShape Is Nothing Then Exit Sub
    '
    ' Sinon on adapte son placement vertical
     SegmentShape.Top = Target.Top - (SegmentShape.Height / 2)
End Sub

Sub Worksheet_SelectionChange(ByVal Target As Range)
'Cale les segments prédéfinis sur la première ligne visible de l'écran
'Pour un gain de temps, aucune vérification d'existence de segments
'n'est faite

    Set SegmentShape1 = Me.Shapes("Ss type")
    Set SegmentShape2 = Me.Shapes("Bénéficiaire")
    Set SegmentShape3 = Me.Shapes("Type")
    Set SegmentShape4 = Me.Shapes("Où")
    With ActiveWindow.VisibleRange 'Toutes les cellules visibles à l'écran
        premiereLigne = .Row
    End With
    SegmentShape1.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape2.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape3.Top = Cells(premiereLigne + 1, 1).Top
    SegmentShape4.Top = Cells(premiereLigne + 26, 1).Top
End Sub