VBA Problème d'insertion d'images

Sub Import()
  Dim C As Range, Chemin As String, Photo As String, Img As Object, Larg As Double, H As Double
  Larg = [B1].Width
  Chemin = "E:\Users\Fleurent\Desktop\LIVRE\"
  Chemin = "D:\Users\dcola\Pictures\"
  With ActiveSheet
    For i = .Shapes.Count To 1 Step -1
      .Shapes(i).Delete
    Next i
  End With
  For Each C In Range("D3", Cells(Rows.Count, 4).End(xlUp))
    H = C.Height
    Photo = C.Value
    Set Img = ActiveSheet.Pictures.Insert(Chemin & Photo & ".jpg")
    With Img
      .Width = Larg
      If C.Height < .Height Then
        .Height = H
      End If
      .Left = C.Offset(, -2).Left
      .Top = C.Offset(, -2).Top
    End With
  Next C
End Sub