XL 2019 Transformer une URL en image dans une cellule excel

Lau79

XLDnaute Nouveau
Bonjour à tous,

Assez novice en VBA j'ai tenté d'appliquer les codes que j'ai pu trouver à ce sujet, malheureusement rien ne fonctionne comme je l'aimerais.
Je cherche à afficher les images des url des cellules B2:B5 et C2:C5 dans une nouvelle feuille.
Pourriez-vous m'aider svp?

Merci et belle fin de semaine!

Lau
 

Pièces jointes

  • Forum excel 2.xlsx
    17.6 KB · Affichages: 8

patricktoulon

XLDnaute Barbatruc
Bonjour
une méthode vieille comme le monde
exemple
je met l'image du lien en B1 dans la feuil2
VB:
Sub test()
Dim img$
feuil6 c'est le sheets(pic)
img = fichierIMage(Feuil6.[b2].Value)


Sheets(2).Pictures.Insert (img)

Kill ThisWorkbook.Path & "\imagetemp.jpg"
End Sub
Function fichierIMage(url As String)
    Dim ReQ As Object, oStream As Object
      'On Error Resume Next    'On ne gère pas les erreurs
    Set ReQ = CreateObject("Microsoft.XMLHTTP")
    ReQ.Open "get", url, False
    ReQ.send
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write ReQ.responsebody
   oStream.SaveToFile ThisWorkbook.Path & "\imagetemp.jpg"
    oStream.Close
fichierIMage = ThisWorkbook.Path & "\imagetemp.jpg"
End Function
 

Lau79

XLDnaute Nouveau
Bonjour
une méthode vieille comme le monde
exemple
je met l'image du lien en B1 dans la feuil2
VB:
Sub test()
Dim img$
feuil6 c'est le sheets(pic)
img = fichierIMage(Feuil6.[b2].Value)


Sheets(2).Pictures.Insert (img)

Kill ThisWorkbook.Path & "\imagetemp.jpg"
End Sub
Function fichierIMage(url As String)
    Dim ReQ As Object, oStream As Object
      'On Error Resume Next    'On ne gère pas les erreurs
    Set ReQ = CreateObject("Microsoft.XMLHTTP")
    ReQ.Open "get", url, False
    ReQ.send
    Set oStream = CreateObject("ADODB.Stream")
    oStream.Open
    oStream.Type = 1
    oStream.Write ReQ.responsebody
   oStream.SaveToFile ThisWorkbook.Path & "\imagetemp.jpg"
    oStream.Close
fichierIMage = ThisWorkbook.Path & "\imagetemp.jpg"
End Function
Merci ! j'ai encore un message d'erreur.
Pourriez-vous m'envoyer votre fichier svp que je le vois en direct ?
 

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T