Sub Вставить_рисунок()
    Dim shpHost As Shape, shp As Shape
    Dim var
    
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.Shapes("Вставленный").Delete
    On Error GoTo 0
    'здесь укажите имя фигуры
    Set shpHost = ActiveSheet.Shapes("Прямоугольник")
    Set shp = ActiveSheet.Shapes.AddPicture(Range("I4"), False, True, -1, -1, -1, -1)
    shp.Name = "Вставленный"
    shp.LockAspectRatio = True
    If shp.Width > shp.Height Then
        shp.Height = shpHost.Height
        shp.Top = shpHost.Top
        var = shpHost.Left + shpHost.Width / 2
        shp.Left = var - shp.Width / 2
    Else
        shp.Width = shpHost.Width
        shp.Left = shpHost.Left
        var = shpHost.Top + shpHost.Height / 2
        shp.Top = var - shp.Height / 2
    End If
    shp.ZOrder msoSendToBack
    Application.ScreenUpdating = True
End Sub