XL 2019 Afficher une photo stocker dans mon ordinateur et la générer à un endroit précis

Sub InsererImage()
    Dim NomCompletImage As String
    Dim Sh As Shape
    Dim Left As Integer
    Dim Top As Integer
    Dim Width As Integer
    Dim Height As Integer
    
    Left = ActiveCell.Left
    Top = ActiveCell.Top
    Width = 10
    Height = ActiveCell.Height
 
    Set Sh = ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left, Top, Width, Height) 'left, top, width, heigth
 
    NomCompletImage = "H:\Téléchargements\2020-06-18_142553.jpg"
    Sh.Fill.UserPicture NomCompletImage
End Sub

'répertoirePhoto = "XXXXXX" ' Adapter
répertoirePhoto = "H:\Téléchargements\"
'Nom = Range("c11").Text
Nom = "20200704_160359.jpg"

Sub PlacerPhoto()
    Call EffacePhoto(Selection)
    Call InsertPhoto("H:\Téléchargements", "20200704_160359.jpg", Selection, RespecterProportions:=True)
End Sub

Sub EffacePhoto(ByVal Rng As Range)
    Dim s As Shape

    On Error Resume Next
    For Each s In ActiveSheet.Shapes
        If Not Intersect(s.TopLeftCell, Rng.Areas(1)) Is Nothing Then s.Delete
    Next s
    On Error GoTo 0
End Sub

Sub InsertPhoto(ByVal Répertoire As String, ByVal Image As String, ByVal Rng As Range, _
                Optional ByVal RespecterProportions As Boolean = False)
   
    Dim ShapeName As String
  
    'Ajout du \ au nom du répertoire
    If Right(Répertoire, 1) <> "\" Then Répertoire = Répertoire & "\"
    
    'Pour différencier le Shape Name et permettre d'avoir la même image plusieurs fois dans la feuille
    ShapeName = Rng.Areas(1).Address & Image
   
    'https://docs.microsoft.com/fr-fr/office/vba/api/excel.shaperange
    With ActiveSheet
        Rng.Areas(1).Select
        .Pictures.Insert(Répertoire & Image).Name = ShapeName
        .Shapes(ShapeName).Left = Rng.Areas(1).Left
        .Shapes(ShapeName).Top = Rng.Areas(1).Top
        .Shapes(ShapeName).Height = Rng.Areas(1).Height
        .Shapes(ShapeName).Width = Rng.Areas(1).Width
       
        If RespecterProportions Then
            .Shapes(ShapeName).LockAspectRatio = msoTrue
             If .Shapes(ShapeName).Height > Rng.Areas(1).Height Then
                .Shapes(ShapeName).Width = Rng.Areas(1).Width * (Rng.Areas(1).Height / .Shapes(ShapeName).Height)
            End If
        Else
            .Shapes(ShapeName).LockAspectRatio = msoFalse
        End If
       
    End With
End Sub