Sélectionner une image insérée par macro

Bonjour

Tout d'abord un grand merci à tous ceux qui participent à ce forum dans lequel j'ai déjà puisé de nombreuses informations

Ma feuille excel comporte un planning dans lequel les images sont insérées par macro en fonction de l'activité choisie.

Sub InsererImage()
Dim val As Integer
Dim Nd As String

    Application.EnableEvents = False
    Application.ScreenUpdating = False

Dim objImg As Object

On Error GoTo FIN
    'On retrouve dans la feuille activité l'image correspondante
    val = Application.Match(ActiveCell, Sheets("Activité").Range("A1:A50"), 0)
    Nd = "B" & val
    ' on copie l'image dans la cellule
    Sheets("Activité").Range(Nd).Copy Destination:=ActiveCell.Offset(1, 0)

  ' on enlève la bordure
    ActiveCell.Borders(xlEdgeBottom).LineStyle = xlNone

FIN:
    Application.EnableEvents = True
End Sub

Je voudrais pouvoir :

1 Enlever l'image présente dans la cellule si elle existe

2 Insérer l'image au milieu de la cellule et pouvoir éventuellement la redimensionner

En fait, je n'arrive pas à sélectionner l'image présente dans la cellule pour soit la supprimer, soit la centrer

Merci d'avance pour votre aide

Bonjour

Voilà j'ai trouvé une solution. Je l'indique si jamais quelqu'un en avait besoin.

Il y a sans doute des solutions plus expertes mais celle-là a l'air de marcher.

Il me reste à trouver pourquoi certaines images ne veulent pas s'insérer. Si quelqu'un a la réponse, je la veux bien.

Sub InsererImage()
Dim val As Integer
Dim Nd As String
Dim Obj As Object
Dim arShapes() As Variant
Dim monRange As Range
Dim monimage As String

    Application.EnableEvents = False
    Application.ScreenUpdating = False

Dim objImg As Object

    'On retrouve dans la feuille activité l'image correspondante
    val = Application.Match(ActiveCell, Sheets("Activité").Range("A1:A50"), 0)
    Nd = "B" & val

    Set monRange = ActiveCell.Offset(1, 0)

' On enlève l'image précedente si il y en a une
    suppressionImage
' on copie l'image dans la cellule
    Sheets("Activité").Range(Nd).Copy Destination:=ActiveCell.Offset(1, 0)

    'Set monRange = ActiveCell.Offset(1, 0)
 On Error GoTo LAFIN
    ' on agrandit l'image
    For Each s In ActiveSheet.Shapes

     If Not Intersect(s.TopLeftCell, monRange) Is Nothing Then
     With ActiveCell.Offset(1, 0)
        w = .Offset(1, 0).Left - .Left
        h = .Offset(1, 0).Top - .Top
        End With

    ' position picture
    With s
        .Width = w
        .Height = h
    End With
   ' on positionne l'image agrandit
    With ActiveCell.Offset(1, 0)
        t = .Top
        l = .Offset(1, 0).Left + ((.Offset(1, 0).Width - s.Width) / 2)
    End With
    With s
        .Top = t
        .Left = l
    End With
   End If
Next s
LAFIN:
'On enlève la ligne
ActiveCell.Borders(xlEdgeBottom).LineStyle = xlNone

Application.EnableEvents = True
End Sub

Sub suppressionImage()
Set monRange = ActiveCell.Offset(1, 0)

' on enlève l'image présente
On Error GoTo FIN
    For Each s In ActiveSheet.Shapes
   If Not Intersect(s.TopLeftCell, monRange) Is Nothing Then
      s.Delete
    End If
    Next s
FIN:
End Sub