XL 2019 [VBA] Modifier la position de l'image contenue dans la cellule active

.Name = .Name & "_" & Cells(ligne, colonne).Address(0, 0)

'*********************************************
'dans le module de la feuille
' on charge newcell en tant que range (activecell)
'Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'If Target.Row = 9 Then Set newcell = ActiveCell'uniquement si l'on est en ligne 9
'End Sub
'**********************************************
'et la macro attribuée  au bouton dans le module (A05_Photo)
Public newcell As Range
Sub Image()
    Dim tablo, X&, shap
    If Not newcell Is Nothing Then    ' si newcell est une cellule( celle qui est sensé etre selectionnée )
        Application.CopyObjectsWithCells = True    ' on parametre la copie de  cellule avec leur object
        tablo = Application.Transpose([Liste_chariots].Value)    'la liste
        X = Application.IfError(Application.Match(Feuil4.[d1].Value, tablo, 0), 0)    ' le find par match on gere l'erreur meme si on est sur car il se peut que D soit modifier au clavier
        Debug.Print "trouvé en A" & X + 1 & " donc l'image est en ""B" & X + 1 & """"    'console
        Feuil1.Cells(X + 1, 1).Offset(, 1).Copy newcell    ' un simple copy destination

        With ActiveSheet    'on renomme  + console pour controler
            Set shap = .Shapes(.Shapes.Count - 1)
            With shap
                Debug.Print "Nom avant :" & .Name
                .Name = .Name & newcell.Address(0, 0)    '& vbCrLf & .Shapes(.Shapes.Count).Name = [d1].Value
                Debug.Print "Nom apres :" & .Name
                'si on veut etre tres précis au cas ou dans index elle soit placé  a l'agachon  ou que les cellule n'est pas les memes tailles
                PlaceThePictureInCenterRange newcell, shap, 80   '80% la marge reduit forcement la taille  à vous de voir
            End With
        End With
    End If
    Set newcell = Nothing    'on decharge newcell
End Sub

Sub PlaceThePictureInCenterRange(rng As Range, Obj, Optional Percentsize As Long = 100)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, Wx#, Yx#
    Wx = rng.Cells(1).MergeArea.Width * (Percentsize / 100)
    Yx = rng.Cells(1).MergeArea.Height * (Percentsize / 100)
    Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
    With Obj
        If TypeName(Obj) = "Shape" Then .LockAspectRatio = msoTrue Else .ShapeRange.LockAspectRatio = msoTrue
        .Width = .Width * Ratio
        .Top = rng.Top + ((rng.Cells(1).MergeArea.Height - .Height) / 2)
        .Left = rng.Left + ((rng.Cells(1).MergeArea.Width - .Width) / 2)
    End With
End Sub