Suivi de la Cellule

Bonjour à tous!

J'ai un rectangle (Insertion-Illustrations-Formes) du nom de "RectRouge".

Il y a un VBA, qui me sert pour des boutons à droite.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 Dim ecran
 Set ecran = ActiveWindow.VisibleRange
 With ActiveSheet
 Shapes("Image A").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image A").Top = ecran.Top + 20
 Shapes("Image B").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image B").Top = ecran.Top + 125
 Shapes("Image C").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image C").Top = ecran.Top + 230
 Shapes("Image D").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image D").Top = ecran.Top + 335
 Shapes("Image E").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image E").Top = ecran.Top + 440
 Shapes("Image F").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image F").Top = ecran.Top + 545
 Shapes("Image G").Left = ecran.Left + 2963 ' adapter le nom de l'image et les dimensions
 Shapes("Image G").Top = ecran.Top + 650
 Shapes("Image H").Left = ecran.Left + 2966 ' adapter le nom de l'image et les dimensions
 Shapes("Image H").Top = ecran.Top + 652
 Shapes("Rectangle I").Left = ecran.Left + 315 ' adapter le nom de l'image et les dimensions
 Shapes("Rectangle I").Top = ecran.Top + 10
 Shapes("Rectangle J").Left = ecran.Left + 315 ' adapter le nom de l'image et les dimensions
 Shapes("Rectangle J").Top = ecran.Top + 40

 End With
End Sub

J'aimerais savoir comment faire pour que ce rectangle puisse aller sur la cellule sélectionnée.

Je vous remercie beaucoup pour votre aide, en vous souhaitant de très Bonnes Fêtes !!!!

Bonjour,

Dans un module standard :

Sub FormeDansCellule(ByVal Cellule As Range, ByVal FormeChoisie As Shape)

    With FormeChoisie
         .Top = Cellule.Top
         .Left = Cellule.Left
         .Width = Cellule.Width
         .Height = Cellule.Height
    End With

End Sub

Dans votre module d'onglet :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

        If Target.Count > 1 Then Exit Sub

        FormeDansCellule Target, Shapes("RectRouge")

End Sub

PARFAIT !

Merci beaucoup ! Et bonne Année à vous !