XL 2016 Adapter une image à une cellule

Function Insere_image2(ByVal NomImage As String, ByVal Repertoire As String)
 
Dim FicImg As String, Ad As String
Dim GaucheMilieuCellule As Double
 
        With Selection
             Ad = Selection.Address
             GaucheMilieuCellule = .Left + .Width / 2
        End With
        FicImg = Repertoire & "\" & NomImage
 
        ActiveSheet.Pictures.Insert(FicImg).Select
        With Selection.ShapeRange
             .LockAspectRatio = True ' proportions d'origine lorsque vous la redimensionnez
             .Top = Range(Ad).Top
             .Height = Range(Ad).Height
             .Left = GaucheMilieuCellule - .Width / 2
        End With
 
        With Selection
             .Placement = xlMoveAndSize
             .PrintObject = True
        End With
 
End Function

Sub Insere_image()
 
Dim FicImg As Variant
Dim Ad As String
Dim GaucheMilieuCellule As Double
 
        ChDir ThisWorkbook.Path
        With Selection
             Ad = Selection.Address
             GaucheMilieuCellule = .Left + .Width / 2
        End With
        FicImg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")
        If FicImg = "Faux" Then Exit Sub
 
        ActiveSheet.Pictures.Insert(FicImg).Select
        With Selection.ShapeRange
             .LockAspectRatio = True ' proportions d'origine lorsque vous la redimensionnez
             .Top = Range(Ad).Top
             .Height = Range(Ad).Height
             .Left = GaucheMilieuCellule - .Width / 2
        End With
 
        With Selection
             .Placement = xlMoveAndSize
             .PrintObject = True
        End With
 
End Sub

Sub test1()
 Dim Shap as shape
set shap=activesheet.shapes("monbateau")
PlaceThePictureInCenterRange [C4].MergeArea, shap, 90    'le dernier argument c'est la marge (facultatif)
End sub

Sub PlaceThePictureInCenterRange(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, Wx#, Yx#
    Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
    Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 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

Sub test()
    Dim shap, t
    Set shap = ActiveSheet.Shapes("shapebleue")
    t = GetDimensionPictureRatio([C4].MergeArea, shap, 90)
    With shap
        .LockAspectRatio = False
        .Left = t(1)
        .Top = t(2)
        .Width = t(3)
        .Height = t(4)
    End With
End Sub

Function GetDimensionPictureRatio(rng As Range, Obj As Variant, Optional PercentMarge As Long = 100)     'la marge exprime un pourcentage de 1 à x%
    Dim Ratio#, Wx#, Yx#, t(1 To 4)
    Wx = rng.Cells(1).MergeArea.Width * (PercentMarge / 100)
    Yx = rng.Cells(1).MergeArea.Height * (PercentMarge / 100)
    Ratio = Application.Min(Wx / Obj.Width, Yx / Obj.Height)
    t(3) = (Obj.Width * Ratio)
    t(4) = (Obj.Height * Ratio)
    t(1) = rng.Left + ((rng.Width - t(3)) / 2)
    t(2) = rng.Top + ((rng.Height - t(4)) / 2)
     GetDimensionPictureRatio = t
End Function

Application.Volatile

Function AfficheImage(NomImage, Optional rep As String)
Application.Volatile
If IsMissing(rep) Then rep = ThisWorkbook.Path & "\"

=STXT(CELLULE("filename";A1);TROUVE("]";CELLULE("filename";A1))+1;255)