Insérer une image Web dans un userform

**bboy-eazy** · 28/10/2015, 16h07

Bonjour,

Je voulais savoir si il est possible de récupérer directement une image internet dans un userform? Je ne trouve pas grand chose sur internet à part cette API mais l'enregistrement ne se fait pas...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
Private Declare Function URLDownloadToFile Lib "urlmon" Alias _
        "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
        ByVal szFileName As String, ByVal dwReserved As Long, _
        ByVal lpfnCB As Long) As Long

J'ai vu aussi un truc sur un webbrowser mais je ne comrpend rien...

En fait je voudrais pouvoir afficher directement l'image d'internet (sans l'enregistrer sur mon PC) dans le contrôle image de mon userform.
Le fichier doit etre aprtager et du coup comme les chemins ne sont pas les mêmes il faut que tous les utilisateurs puissent voir l'image qui se trouve sur internet.

Est ce possible?

merci d'avance de votre aide

**PMO2017** · 28/10/2015, 19h05

J'ai vu aussi un truc sur un webbrowser mais je ne comprend rien...
En fait je voudrais pouvoir afficher directement l'image d'internet (sans l'enregistrer sur mon PC) dans le contrôle image de mon userform.

Bonjour,

L'Api URLDownloadToFile charge l'image sur votre ordinateur, ce que vous ne voulez pas.

Pour le WebBrowser, voici un exemple ci-dessous.
La restriction est que cet ActiveX n'est pas forcément présent et enregistré sur toutes les machines.
Chez moi cela fonctionne mais en sera-t-il de même dans votre situation (???).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Private Sub UserForm_Activate()
Dim WBS As Object 'WebBrowser
Dim mySource As String
'---
'### URL de l'image sur internet (à adapter) ###
mySource = "http://static.wamiz.fr/images/animaux/chiens/medium/chien-loup-de-saarloos-1118.jpg"
'###############################################
 
Set WBS = Me.Controls.Add("Shell.Explorer.2")
WBS.Height = 200
WBS.Left = 20
WBS.Navigate "about:<html><body scroll='no'><img src='" & mySource & "'></img></body></html>"
DoEvents
'---
With WBS.document.body.Style
  '--- Supprime la bordure ---
  .BorderStyle = "none"
  '--- Applique la couleur de fonds du UserForm ---
  '################################################################################
  '### ATTENTION :                                                              ###
  '### Pour que l'instruction suivante fonctionne, il est impératif de définir  ###
  '### la couleur de fonds du UserForm (BackColor) par le biais de l'onglet     ###
  '### "Palette" de la fenêtre de Propriétés et NON pas par l'onglet "Système". ###
  '### L'affectation de la couleur par code est également possible avec une     ###
  '### instruction comme, par exemple :       Me.BackColor = 16744576           ###
  '################################################################################
  .backgroundColor = InvertRGB(Me.BackColor)
End With
End Sub
 
Private Function InvertRGB(Color As Long) As Long
Dim A$
Dim B$
Dim i&
A$ = Hex(Color)
Do Until Len(A$) >= 6
  A$ = "00" & A$
Loop
For i& = 6 To 2 Step -2
  B$ = B$ & Mid(A$, i& - 1, 2)
Next i&
InvertRGB = CLng("&H" & B$)
End Function

**patricktoulon** · 28/10/2015, 21h08

puréé PMO il c'est envolé la

mais non mais non il y a beaucoup plus simple

dans un evenemnet que tu veut de ton userform le activate pourquoi pas ou celui d'un bouton tu met

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim url As String
url = "http://static.wamiz.fr/images/animaux/chiens/medium/chien-loup-de-saarloos-1118.jpg"
fichierIMage url, Me.Image1

et dans un module standard tu met ceci: c'est une simple requete qui stream le fichier en binaire

pas d'api, pas de webbrowser et le shmilblik est toujour la

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub fichierIMage(url As String, ctrl As Object)
    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
ctrl.Picture = LoadPicture(ThisWorkbook.Path & "\imagetemp.jpg")
End Sub

mais je garde ta proposition PMO elle peut servir dans d'autre circonstences

a savoir que si on fait un active workbook .save apres la requete et un kill sur le fichier téléchargé on ne perds plus l'image

voila voila piece jointe

**bboy-eazy** · 29/10/2015, 07h22

Bonjour,

Merci à vous deux pour vos réponses. cela fonctionne parfaitement pour l'une comme pour l'autre.

Merci PMO pour l'utilisation du WebBrowser.
En effet patrick, c'est pas mal du tout cette méthode, rapide efficace :p

Bonne journée

**davido84** · 29/10/2015, 09h29

Bonjour,
on également stocker temporairement l'image dans un objet Chart pour l'afficher ensuite dans le contrôle image :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
'http://boisgontierjacques.free.fr/fichiers/Formulaire/FormAfficheImageWeb.xls
Private Sub UserForm_Initialize()  
  Set f = Sheets("feuil1")
  s = "http://static.wamiz.fr/images/animaux/chiens/medium/chien-loup-de-saarloos-1118.jpg"
  Set img = ActiveSheet.Pictures.Insert(s)
  img.CopyPicture
  f.ChartObjects.Add(0, 0, Me.Image1.Width, Me.Image1.Height).Chart.Paste
  f.ChartObjects(1).Chart.Export Filename:="monimage.jpg"
  f.ChartObjects(1).Delete
  Me.Image1.Picture = LoadPicture("monimage.jpg")
  Kill "monimage.jpg"
  img.Delete
End Sub

A+

**patricktoulon** · 29/10/2015, 12h37

bonjour et oui davido
c'est exact mais c'est plus long (manipulation d'object sur le sheets)
la requete stream avaec adob.stream c'est quasi instantané

ta methode je m'en sert pour copier une SHAPE!! image(oleobject) dans un userform sans les apis

**Reaverman** · 17/08/2018, 21h50

Envoyé par patricktoulon

puréé PMO il c'est envolé la

dans un evenemnet que tu veut de ton userform le activate pourquoi pas ou celui d'un bouton tu met

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Dim url As String
url = "http://static.wamiz.fr/images/animaux/chiens/medium/chien-loup-de-saarloos-1118.jpg"
fichierIMage url, Me.Image1

et dans un module standard tu met ceci: c'est une simple requete qui stream le fichier en binaire

pas d'api, pas de webbrowser et le shmilblik est toujour la

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub fichierIMage(url As String, ctrl As Object)
    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
ctrl.Picture = LoadPicture(ThisWorkbook.Path & "\imagetemp.jpg")
End Sub

mais je garde ta proposition PMO elle peut servir dans d'autre circonstences

a savoir que si on fait un active workbook .save apres la requete et un kill sur le fichier téléchargé on ne perds plus l'image

voila voila piece jointe

Bonsoir Patrick,
j'ai téléchargé votre fichier de démo pour voir ce que ça donnait, mais chez moi le cadre image reste désespérément gris, et lorsque je clique sur le bouton rien ne se passe... (je suis sous Excel 2010)
Une idée de ce qui pourrait ne pas aller ? Je n'ai rien modifié du code

Merci d'avance

Reaverman

**patricktoulon** · 17/08/2018, 22h36

re
bonsoir reaverman
ben peut etre parce que depuis le temps surtout maintenant les protocoles on changé voir endurcis et que la connection exige la securité et donc "http" devient "https"
je dis ca moi je dis rien

ceci: pourrait t'intéresser aussi

**Reaverman** · 17/08/2018, 23h41

Pas bête. J'avais pour ma part vérifié que l'image se chargeait bien avec le préfixe http dans mon navigateur... mais l'exigence de sécurité vient effectivement peut-être d'Office

Petite question subsidiaire : peux-tu me confirmer qu'il est impossible de charger (sans complication) un fichier PNG ?

Merci à toi, et un immense bravo pour ta contribution au site... Vu le nombre de sujets que j'ai parcourus pour me mettre à jour, ta contribution intense m'a beaucoup aidé !!!

malheureusement, même en ajoutant le "s" je n'ai toujours rien... :/

**patricktoulon** · 18/08/2018, 09h50

re
donne moi le lien de cette image que tu n'arrive pas a loader

**patricktoulon** · 18/08/2018, 18h47

re
tu peux telecharger toute sorte type d'image avec cette requette et pas que des images d'ailleurs
parcontre pour charger un png dans un userform refere toi a ma contrib il a 1 ou 2 astuces qui te permettent d'y parvenir

**Reaverman** · 19/08/2018, 01h18

Envoyé par patricktoulon

re
donne moi le lien de cette image que tu n'arrive pas a loader

Bonsoir Patrick,

Bah... c'est le chien-loup de sarloos... je n'ai fait qu'ajouter le "s" dans le lien pour voir si ça marche, mais chez moi rien n'apparaît dans le cadre image...

**Reaverman** · 19/08/2018, 01h20

Envoyé par patricktoulon

re
tu peux telecharger toute sorte type d'image avec cette requette et pas que des images d'ailleurs
parcontre pour charger un png dans un userform refere toi a ma contrib il a 1 ou 2 astuces qui te permettent d'y parvenir

oui merci, j'ai commencé à potasser ça (mais j'ai eu du monde à la maison toute la journée donc pas eu le temps d'approfondir :'D ), merci encore pour toutes tes formidables contributions !

**patricktoulon** · 25/08/2018, 01h06

salut Reaverman

en faisant le tri dans mes archive vba et image j'ai retrouver mon model 4 facon differentes
je te le met a dispo ici

**Reaverman** · 25/08/2018, 10h00

Envoyé par patricktoulon

salut Reaverman

en faisant le tri dans mes archive vba et image j'ai retrouver mon model 4 facon differentes
je te le met a dispo ici

merci !!!!

Pour le moment j'ai mis de côté cette fonctionnalité et mon petit programme fonctionne parfaitement (après un mois et demi de développement nocturne - on trouve le temps quand on peut :'D )
J'ai appris pas mal de choses en VBA pour pouvoir tenir mon cahier des charges, et une bonne partie des réponses les plus pertinentes que j'ai glanées sur des forums étaient signés de ta main (pur hasard, mais peut-être pas tant que ça, vu le volume et la qualité de tes contributions), alors un très très grand merci à toi ! Tu expliques toujours les choses comme il faut, et ton code est suffisamment lisible pour que je puisse à chaque fois comprendre ton raisonnement et ta démarche, et pouvoir écrire le code dont j'ai besoin en utilisant les bonnes fonctions. Bref, sans toi, je n'aurais sûrement toujours pas fini !

Reaverman

**geracole** · 06/09/2019, 16h07

Envoyé par patricktoulon

salut Reaverman

en faisant le tri dans mes archive vba et image j'ai retrouver mon model 4 facon differentes
je te le met a dispo ici

Bonjour Patrick,
J'ai besoin de télécharger une image .png depuis le web pour la placer dans un userform.
J'ai trouvé ta réponse, mais je ne peux pas télécharger ton fichier.
AVAST le met en Quarantaine et si j'arrête AVAST, le transfert échoue !!
Peux-tu mettre le code dans le post pou pouvoir le copier.
Merci.

**patricktoulon** · 06/09/2019, 19h20

bonjour geracole

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Private Sub CommandButton1_Click()
Dim url As String
url = "https://static.wamiz.fr/images/animaux/chiens/medium/chien-loup-de-saarloos-1118.jpg"
fichierIMage url, Me.Image1
End Sub
'
Private Sub fichierIMage(url As String, ctrl As Object)
    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
ctrl.Picture = LoadPicture(ThisWorkbook.Path & "\imagetemp.jpg")
Kill ThisWorkbook.Path & "\imagetemp.jpg"
'ThisWorkbook.Save
End Sub

**geracole** · 06/09/2019, 22h58

Re-bonsoir Patrick.
Oui, j'avais trouvé et testé ce code.
Mais ce qui m'intéresse c'est l'import d'une image .png pour mettre dans l'userform.
Il manque la conversion .png vers .jpg ou .bmp
Merci.

**patricktoulon** · 07/09/2019, 00h51

re
Ok avec la conversion

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
Option Explicit
'reduire la qualité d'une image
Const wiaFormatBMP = "{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatPNG = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatGIF = "{B96B3CB0-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
Const wiaFormatTIFF = "{B96B3CB1-0728-11D3-9D7B-0000F81EF32E}"
'
Private Sub CommandButton1_Click()
    Dim url As String
    url = "https://encrypted-tbn0.gstatic.com/images?q=tbn:ANd9GcSMQ5Pr-uBrDVUgT6X55TG06SvLCiOrV4WdewejeBBaJNbKG87PPw"
    fichierIMage url, Me.Image1
End Sub
'
Private Sub fichierIMage(url As String, ctrl As Object)
    Dim ReQ As Object, oStream As Object, PnG$, jpeg$
    'On Error Resume Next    'On ne gère pas les erreurs
    PnG = ThisWorkbook.Path & "\pngtemp.png"
    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 PnG
    oStream.Close
    jpeg = convert_PNGTOJPEG(PnG)
    ctrl.Picture = LoadPicture(jpeg)
    Kill jpeg
    'ThisWorkbook.Save
End Sub
'
Function convert_PNGTOJPEG(chemin)
    Dim Img As Object, Ip As Object
    Set Img = CreateObject("WIA.ImageFile")    'Création conteneur pour l'image à manipuler
    Set Ip = CreateObject("WIA.ImageProcess")
    Img.LoadFile (chemin)
    'reduit la qualité a 50%
    Ip.Filters.Add (Ip.FilterInfos("Convert").FilterID)
    Ip.Filters(1).Properties("FormatID").Value = wiaFormatJPEG
    'Ip.Filters(1).Properties("Quality").Value = 50    ' ce nombre represente le pourcentage de qualité donc ici 50% tu peux encore reduire  mais attention a la déperdition des couleurs
    Set Img = Ip.Apply(Img)
    If Dir(Replace(chemin, ".png", ".jpg")) <> "" Then Kill Replace(chemin, ".png", ".jpg")
    If Dir(ThisWorkbook.Path & "\pngtemp.png") <> "" Then Kill ThisWorkbook.Path & "\pngtemp.png"
    'et on la sauve
    Img.SaveFile Replace(chemin, ".png", ".jpg")
    convert_PNGTOJPEG = Replace(chemin, ".png", ".jpg")
End Function
Private Sub UserForm_Click()
End Sub

la png et la jpeg sont supprimées automatiquement

**geracole** · 17/09/2019, 09h35

Merci Patrick, avec un peu de retard.

Insérer une image Web dans un userform [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager