XL 2010 Erreur 1004 : Impossible de lire la propriété Insert de la classe Pictures

[Baroukar]

Bonjour à tous,

Voici mon problème, j'ai un macro pour transformer tous mes liens URL en image sur mon excel, le macro fonctionne très bien sur mon ordi (où j'ai la version Excel 2010) mais dès que je l'envoie à des collègues possédant la version Excel 2019, un message d'erreur s'affiche : "Erreur d'exécution '1004' : Impossible de lire la propriété Insert de la classe Pictures".

Voici le macro :

Sub LienImage()

    For Each cel In Selection
        cel.Offset(0, 1).Select
        cel.Offset(0, 1).RowHeight = 200
        cel.Offset(0, 1).ColumnWidth = 80

        If URLValid(cel.Value) = 0 Or HttpExists(cel.Value) = 0 Then
           cel.Offset(0, 1).Value = "Photo non dispo"
        Else
            Set Image = ActiveSheet.Pictures.Insert(cel.Value)
            With Image
                .ShapeRange.LockAspectRatio = msoTrue
                .Width = cel.Offset(0, 1).Width
                .Height = cel.Offset(0, 1).Height
                .Left = cel.Offset(0, 1).Left
                .Top = cel.Offset(0, 1).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

Et quand je fais Débogage il m'indique que c'est cette ligne là qui pose problème :

Set Image = ActiveSheet.Pictures.Insert(cel.Value)

Merci d'avance !

Baroukar

 

[isramail]

Function URLValid(url As String) As Boolean
    URLValid = True
    Select Case True
        Case url Like "*.png*"
        Case url Like "*.jpg*"
        Case url Like "*.jpeg*"
        Case url Like "*.bmp*"
        Case Else: URLValid = False
    End Select
End Function

Merci Fanch55 !
Ça a bien l’air de fonctionner.
Merci infiniment pour votre aide !