XL 2016 Positionner une image au centre d'une cellule

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Application.Intersect(Target, Range("Table")) Is Nothing Then

Dim Reponse As Variant
Dim FileName$
Dim SH As Shape
'--- Choix d'un fichier ---
Reponse = Application.GetOpenFilename( _
    FileFilter:="Tout fichier (*.*), *.*", _
    Title:="Insérer un fichier sous forme d'icône dans la cellule active")
If Reponse = False Then Exit Sub
FileName$ = Mid(Reponse, InStrRev(Reponse, "\") + 1)
'--- Le fichier est-il déjà présent ? ---
On Error Resume Next
For Each SH In ActiveSheet.Shapes
  If SH.AlternativeText = Reponse Then
    Range(SH.TopLeftCell.Address).Select
    MsgBox prompt:="Le fichier ''" & Reponse & "'' existe déjà" & vbLf & _
          " en cellule " & SH.TopLeftCell.Address(False, False), _
          Title:="Le fichier sous forme d'icône existe déjà"
    Exit Sub
  End If
Next SH
On Error GoTo 0

Application.ScreenUpdating = False
'--- Crée la Shape ---
Set SH = ActiveSheet.Shapes.AddOLEObject( _
    FileName:=Reponse, DisplayAsIcon:=False, _
    IconFileName:=Application.Path & "\" & "Excel.exe", _
    IconIndex:=0, IconLabel:=FileName$)
'--- Propriétés de la Shape ---
SH.AlternativeText = Reponse  'Identificateur unique

SH.TopLeftCell = ActiveCell   'Localisation sur cellule

    '°°° Taille °°°
SH.Width = 40
SH.Height = 40

Application.ScreenUpdating = True

  Cancel = True
End If
End Sub