Insérer image dans une cellule

[https://www.commentcamarche.net/contents/446-fichier-sub Sub] Macro4()
'
' Macro4 Macro
'

'
    Range("D2").Select
    ActiveSheet.Pictures.Insert( _
        "/Users/ludwigbarrachin/Desktop/Ludwig/Images livres/Franck Thilliez/Angor1.jpeg" _
        ).Select
End Sub

Dim Fichier As String
Dim Emplacement As Range
Dim Shp As Shape
Dim DerLg, Lg, Climg, Clad, Claut, Clti As Integer
Dim Chemin As String

Sub InsererImage()

'Efface les images déjà existantes
For Each Shp In ActiveSheet.Shapes
   Shp.Delete
Next Shp

'ligne départ pour la boucle
Lg = 2

'ligne de fin pour la boucle
DerLg = Cells(65536, 1).End(xlUp).Row

'colonne où insérer l'image
Climg = Sheets("Paramètres").Range("B7").Value

'colonne où trouver le chemin d'accès de l'image, de l'auteur et du titre
Clad = Sheets("Paramètres").Range("B8").Value
Claut = Sheets("Paramètres").Range("B5").Value
Clti = Sheets("Paramètres").Range("B6").Value

Do While Lg <= DerLg

'mise en mémoire du chemin d'accès, m'évite de mettre une formule en C
Fichier = Dir(CStr(Sheets("Paramètres").Range("B1").Value & "/" & Sheets("Liste").Cells(Lg, Claut) & "/" & Sheets("Liste").Cells(Lg, Clti)) + ".*")
Chemin = Sheets("Paramètres").Range("B1").Value & "/" & Sheets("Liste").Cells(Lg, Claut) & "/" & Fichier

'sélection de la cellule où insérer l'image
Cells(Lg, Climg).Select
    
    On Error Resume Next
        
    'dimensionner la cellule, les dimensions sont dans la feuille paramètres
    With Cells(Lg, Climg)
        .Select
        .RowHeight = Sheets("Paramètres").Range("B2").Value
        .ColumnWidth = Sheets("Paramètres").Range("B3").Value
    End With
    
    'insertion et mis en forme de l'image
    Set Emplacement = ActiveCell
    
    ActiveSheet.Shapes.AddPicture FileName:=Chemin, _
        LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, _
        Left:=Emplacement.Left + 2, _
        Top:=Emplacement.Top + 5, _
        Width:=Emplacement.Width - 4, _
        Height:=Emplacement.Height - 10

Lg = Lg + 1

Loop

    'j'applique à toutes les images le déplacement et le dimensionnement avec la cellule
    For Each Shp In ActiveSheet.Shapes
        Shp.Placement = xlMoveAndSize
    Next Shp

End Sub