Transformer un lien image en image

Option Explicit

Private Sub Workbook_Open()
Dim sp As Shape

  'À adapter
  Sheets(1).Activate
  For Each sp In ActiveSheet.Shapes
  If sp.Type <> 8 And sp.Type <> 12 Then sp.Delete
  Next sp
  ActiveSheet.Range("h2").ClearContents
End Sub

Option Explicit

Sub Imprimer()
Dim lig&, rep$, nom$, cel As Range, img As Picture, sp As Shape, pos, prenom

    Application.ScreenUpdating = False
   
   
    On Error Resume Next
   
    For Each sp In ActiveSheet.Shapes
      If sp.Type <> 8 And sp.Type <> 12 Then sp.Delete
    Next sp

   
    With ActiveSheet
                'lig - nom et rep sont à adapter
        lig = .Range("b" & Rows.Count).End(xlUp).Row + 1
        nom = .Range("j2") & ".jpg" '  'lien de l'image
        Set img = .Pictures.Insert(nom)
        Set cel = Range("j2")
        prenom = Split(Dir(nom), ".jpg")(0)
        img.Name = prenom
        .Range("h2") = .Range("l2") & " " & img.Name
        Set pos = cel
        img.Select
        With Selection
            .Left = pos.Left
            .Top = pos.Top
            .Height = pos.Height
            .Width = pos.Width
            .Placement = xlMove
            If .ShapeRange.Height <> pos.Height Then
                .ShapeRange.Height = pos.Height:
                .ShapeRange.LockAspectRatio = msoFalse
            End If

            If .ShapeRange.Width <> pos.Width Then
                .ShapeRange.Width = pos.Width:
                .ShapeRange.LockAspectRatio = msoTrue
            End If
        End With
        .PageSetup.PrintArea = "a1:j" & lig
        .PrintPreview
        Application.Goto .Range("a1")
    End With
   
End Sub