Macro pour afficher et redimensionner images

Bonjour et bonne année,

Je vous contacte car je suis sur excell 2013

et j'ai un fichier avec de nombreux produits.

J'affiche avec une macro les images de tous ces produits dans une colonne à partir d'une autre colonne comportant l'adresse URL de mon image (mes images sont dans un dossier de mon site Internet).

Jusque là tout va bien mes images s'affichent bien. Mais par contre j'ai certaines images très longues. qui dépassent beaucoup trop de mes cases.

Idéalement j'aurais aimé que ma macro m'affiche mes images et me les redimensionne en gardant la proportion et surtout en ne dépassant pas des cases que ca soit en hauteur ou en largeur.

Voici ma macro (le cel.offset(0,6) est parceque ma colonne source est à 6 colonnes à gauche de ma destination) :

Sub LinkToImage()
    For Each cel In Selection
        cel.Offset(0, 6).Select
        cel.Offset(0, 6).RowHeight = 100
        cel.Offset(0, 6).ColumnWidth = 40

        If URLValid(cel.Value) = 0 Or HttpExists(cel.Value) = 0 Then
           cel.Offset(0, 6).Value = "Photo non dispo"
        Else
            Set image = ActiveSheet.Pictures.Insert(cel.Value)
            With image
                .ShapeRange.LockAspectRatio = msoTrue
                .Width = cel.Offset(0, 6).Width
                .Height = cel.Offset(0, 6).Height
                .Left = cel.Offset(0, 6).Left
                .Top = cel.Offset(0, 6).Top
            End With
        End If
    Next cel

End Sub

Function URLValid(url As String) As Boolean
    If InStr(url, "png") > 0 Then
        URLValid = True
    ElseIf InStr(url, "jpg") > 0 Then
        URLValid = True
    ElseIf InStr(url, "jpeg") > 0 Then
        URLValid = True
    ElseIf InStr(url, "bmp") > 0 Then
        URLValid = True
    Else
        URLValid = False
    End If
End Function

Function HttpExists(ByVal sURL As String) As Boolean
    Dim oXHTTP As Object
    Set oXHTTP = CreateObject("MSXML2.XMLHTTP")
    On Error GoTo haveError
    oXHTTP.Open "HEAD", sURL, False
    oXHTTP.send
    HttpExists = IIf(oXHTTP.Status = 200, True, False)
    Exit Function
haveError:
    Debug.Print Err.Description
    HttpExists = False
End Function

Merci d'avance de votre aide, car j'ai vraiment besoin que ce soit automatisé, ce fichier évolue souvent et il comprend de nombreuses lignes.

Fabrizio