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

Baroukar

XLDnaute Nouveau
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 :

VB:
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 :

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

Merci d'avance !

Baroukar
 

fanch55

XLDnaute Impliqué
Bonsoir,
D'après le code, vous allez chercher une image sur un hébergeur.
J'ai testé votre code avec l'url gratuite ci-dessous:
VB:
https://previews.123rf.com/images/dotshock/dotshock1801/dotshock180101045/94469587-femme-ing%C3%A9nieur-en-informatique-travaillant-sur-une-tablette-dans-la-salle-des-serveurs-au-centre-de-d.jpg
Tout marche bien, mais je suis en Excel 2016 ( très peu de différence entre 2016 et 2019 ) .

Peut-être un pratiquant d'Excel 2019 pourra vous confirmer le bon/mauvais fonctionnement avec cette adresse .....
 

Baroukar

XLDnaute Nouveau
Bonjour,

En effet j'ai également testé avec votre visuel et cela fonctionne bien...

Je ne comprends pas pourquoi cela bloque avec mes visuels sur 2019 alors que tout fonctionne bien sur 2010...
 

Baroukar

XLDnaute Nouveau
Bonjour,

Je viens d'essayer le 'Shapes.AddPicture' mais cela ne fonctionne pas non plus, cette méthode fonctionne aussi avec les URL ?
 

Roblochon

XLDnaute Barbatruc
Re,

Je vous ai donné le lien vers la page d'aide ms. C'est à moi également d'aller la lire et faire des tests ?

Ceci fonctionne sous 2019 :
VB:
Sub truc()

Const url = "https://previews.123rf.com/images/dotshock/dotshock1801/dotshock180101045/94469587-femme-ing%C3%A9nieur-en-informatique-travaillant-sur-une-tablette-dans-la-salle-des-serveurs-au-centre-de-d.jpg"

ActiveSheet.Shapes.AddPicture _

    url, _

    True, True, 100, 100, 70, 70

End Sub
 

fanch55

XLDnaute Impliqué
Bonjour à tous,

La version ci-jointe avec le addpicture ( l'autre fonctionne également ) .

Mais je pense que quelle que soit la méthode utilisée, vous pouvez vous heurter à des problèmes de sécurité : soit votre feuille est protégée, soit le pare-feu empêche le téléchargement via l'Url .

Si vous pouviez nous indiquer l'Url qui pêche ( si c'est juste une photo, ce ne devrait pas être trop confidentiel ) .... :rolleyes:
 

Fichiers joints

Baroukar

XLDnaute Nouveau
Bonjour,

Je viens d'essayer avec votre excel, cela fonctionne avec les URL que vous aviez déjà mis mais pas avec les miens, je pense que cela doit être dû au fait que mes URL proviennent d'un site qui nécessite une identification. Via Kutools cela fonctionne pourtant...
 

fanch55

XLDnaute Impliqué
Dernier essai avec un autre type de téléchargement ....

Par curiosité, vous vous authentifiez sur votre serveur via un WebBrowser dans Excel ?
 

Fichiers joints

Baroukar

XLDnaute Nouveau
Je viens d'essayer ça fonctionne ! Merci beaucoup !

Pour répondre à votre question, je ne m'identifie pas via un WebBrowser dans Excel !

Encore merci !
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas