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 Barbatruc
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 .....
 

Hasco

XLDnaute Barbatruc
Repose en paix
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 Barbatruc
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:
 

Pièces jointes

  • Baroukar.xlsm
    196.4 KB · Affichages: 28

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...
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 897
Membres
101 833
dernier inscrit
sandra25