Affichage image WEB dans userform

Version imprimable

17/10/2017, 14h52
xoff60

1 pièce(s) jointe(s)

Affichage image WEB dans userform

Bonjour à tous,

Je suis depuis maintenant quelques semaines bloqué sur un point de mon code VBA, en effet je cherche à effectuer un affichage d'image web dans un userform.
L'adresse de cette image Web est dans une listbox de choix.
J'ai reussi avec une image stcoké en dur sur le PC mais depuis internet explorer cela ne fonctionne pas.
J'ai essayé plusieurs méthode que des menbres du forum m'ont conseillé mais sans résultats (je précise que mon niveau en VBA est limité).
En pièce jointe, le fichier concerné.
Si une ame charitable pourrait m'aider cela m'aiderai à débloquer la situation.
Pièce jointe 320179

Bonsoir,

Utilises un WebBrowser, [WebBrowser1.navigate URL] voici le code sur double clics de la ListBow :

Code:

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
 
Private Sub ListBox2_dblClick(ByVal Cancel As MSForms.ReturnBoolean)
 
    'charge le formulaire en mémoire
    Load UserForm2
 
    'paramètre ses contrôles
    With UserForm2
        .Label100 = Me.ListBox2.List(ListBox2.ListIndex, 0)
        .Label101 = Me.ListBox2.List(ListBox2.ListIndex, 1)
        .Label102 = Me.ListBox2.List(ListBox2.ListIndex, 2)
        .Label103 = Me.ListBox2.List(ListBox2.ListIndex, 3)
        .Label104 = Me.ListBox2.List(ListBox2.ListIndex, 4)
        .Label105 = Me.ListBox2.List(ListBox2.ListIndex, 5)
        .Label106 = Me.ListBox2.List(ListBox2.ListIndex, 6)
        .Label107 = Me.ListBox2.List(ListBox2.ListIndex, 7)
 
        .WebBrowser1.navigate Me.ListBox2.List(ListBox2.ListIndex, 8) 'ici, utilise un WebBrowser
 
        .Label108 = Me.ListBox2.List(ListBox2.ListIndex, 9)
        .Label109 = Me.ListBox2.List(ListBox2.ListIndex, 10)
        .Label110 = Me.ListBox2.List(ListBox2.ListIndex, 11)
        .Label111 = Me.ListBox2.List(ListBox2.ListIndex, 12)
        .Show
      End With
 
    'l'affiche
    UserForm2.Show
 
End Sub

bonjour
je reconnais mon module resize il commence a dater depuis j'ai largement alleger le code
apres pour afficher une image du web si ce n'est pas une png tu peux la telecharger dynamiquement sur le disque dur puis loadpicture sur un control image

exemple en cadeau

Code:

1
2
3
4
5
6
7
8
Private Sub CommandButton1_Click()
    With Image1
        .Picture = LoadPicture(Image_par_UrL("http://www.voirlemonde.com/img/paques.jpg"))
 
    End With
 
    Kill ThisWorkbook.Path & "\imagetemp.jpg"
End Sub

Code:

1
2
3
4
5
6
7
8
9
10
11
12
Function Image_par_UrL(url As String) As String
    Dim chemin As String
    chemin = ThisWorkbook.Path & "\imagetemp.jpg"
    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 chemin: oStream.Close
    Image_par_UrL = ThisWorkbook.Path & "\imagetemp.jpg"
    Set oStream = Nothing: Set ReQ = Nothing
End Function

en fouillant dans mes archive j'en ai trouvé une avec l'autre méthode pour écrire le fichier

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Public Sub Get_HTML()
    Dim whrReq As WinHttp.WinHttpRequest, strUrl As String, FileNum As Long, FileData() As Byte
    Set whrReq = New WinHttp.WinHttpRequest
    strUrl = "https://wxs.ign.fr/otq5u930qae01r7zs7n6fj3y/geoportail/wmts/?service=WMTS&version=1.0.0&request=GetTile&layer=GEOGRAPHICALGRIDSYSTEMS.MAPS&style=normal&tilematrixset=PM&tilematrix=15&tilerow=11323&tilecol=16303&format=image/jpeg"
    With whrReq
        .Open "GET", strUrl, False
        .SetRequestHeader "Host", "wxs.ign.fr"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:51.0) Gecko/20100101 Firefox/51.0"
        .SetRequestHeader "Accept", "*/*"
        .SetRequestHeader "Accept-Language", "fr,fr-FR;q=0.8,en-US;q=0.5,en;q=0.3"
        .SetRequestHeader "Referer", "https://ignrando.fr/cirkwi-server/xi/sgfc//?idproduit=2723ET&idserie=k25"
        .SetRequestHeader "Connection", "keep-alive"
        .Send
        If .Status = 200 Then
            FileData = .ResponseBody
            FileNum = FreeFile
            Open "C:\Temp\newpicture.jpg" For Binary Access Write As #FileNum
            Put #FileNum, 1, FileData
            Close #FileNum
        End If
    End With
    Set whrReq = Nothing
End Sub

18/10/2017, 10h07
xoff60

1 pièce(s) jointe(s)

Bonjour à vous,

Tout d'abord Patrick ton code de rezise me sert énormément (grand merci).
Pour ma demande sur une image Web, je dois à mon avis être très mauvais car je n'arrive pas à faire fonctionner vos propositions.
J'ai essyé sur mon fichier = echec
J'ai donc essayé en partant d'un nouveau fichier tout simple et là re-echec.

Je dois passer à coté de quelque chose mais alors quoi....
Pièce jointe 320356
18/10/2017, 10h15
patricktoulon

re

dis moi tu a pas fait le test dans un fichier non enregistrer par hasard? sinon c'est normal thisworkbook.path ne donne rien
18/10/2017, 16h50
xoff60

1 pièce(s) jointe(s)

Patrick,

Effectivement, je n'avais pas enregisté mon fichier, ce qui est fait maintenant.

Mais car il y a toujours un mais, maintenant je me retrouve avec ce message.
Pièce jointe 320460

Il s'agit bien d'une image au format jpg, j'en ai essayé plusieur.
Je pense être poissard.

De plus l'imagetemp.jpg est bien présente sur mon bureau mais celle-ci est vide.
18/10/2017, 20h48
patricktoulon

re

alors ce n'est pas un jpeg dans la page web
serait il possible d'avoir un lien de cette image
19/10/2017, 08h49
xoff60

Bonjour Patrick,

Le lien des photos est celui que tu as mis dans tes exemples.

http://www.voirlemonde.com/img/paques.jpg

J'arrive à l'afficher depuis l'internet explorer mais depuis le classeur excel rien.
19/10/2017, 13h29
xoff60

1 pièce(s) jointe(s)

Patrick,

Bonne nouvelle, j'ai réussi à faire fonctionner l'affichage de l'image, je passe donc par un WebBrowser.
Et cela fonctionne.
Mais comme d'habitude un problème résolu m'en ramène un autre.
Maintenant, a la fin de l'utilisation mon projet reste toujours en marche, je suis obligé de passe par le dévellopeur pour le stopper.
grrrrr.....
Avant l'utilisation du WebBrowser, lorsque je quittais les Userform, le projet se stopper mais maintenant celui reste en marche.
Malgré ma fonction End.Pièce jointe 320776
19/10/2017, 17h35
patricktoulon

2 pièce(s) jointe(s)

re

Citation:

Envoyé par xoff60

Bonjour Patrick,

Le lien des photos est celui que tu as mis dans tes exemples.

http://www.voirlemonde.com/img/paques.jpg

J'arrive à l'afficher depuis l'internet explorer mais depuis le classeur excel rien.

allons donc saperlipopette alors
Pièce jointe 320859
19/10/2017, 17h46
xoff60

1 pièce(s) jointe(s)

Patrick,

Pièce jointe 320884

Quand je dis que je suis poissard.... et pourtant c'est ton fichier.
Bon dans tout les cas, j'ai quand même la solution du Webbrowser qui fonctionne.
Bien sur je me retrouve obligé de fermé tous les classeurs Excel déjà car je ne peux plus naviguer entre les classeurs.

oui le webbrowser provoque certain désagrément incompréhensibles je sais

je suis étonné de ton resultat
tu veux pas mettre un wait juste après la requête pour voir si c'est pas ton débit qui ne laisse pas assez de temps a la requête pour en récupérer le responsebody

parce que il y a une chose de sur si tu ne peut pas télécharger une image ton model même avec le webbrowser ne sera pas pérenne

règle d'abords ces soucis la avant d'avancer dans ton développement pour peu que demain tu change de pc ou de version de excel poufff ca marche plus

re
et avec l'api c'est pas mieux???
Code:

1 2 3 4 5 6 7 8 9 10 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 Private Sub CommandButton1_Click() ' Download the file. URLDownloadToFile 0, "http://www.voirlemonde.com/img/paques.jpg", ThisWorkbook.Path & "\imagetemp.jpg", 0, 0 Image1.Picture = LoadPicture(ThisWorkbook.Path & "\imagetemp.jpg") End Sub

19/10/2017, 23h58
patricktoulon

2 pièce(s) jointe(s)

re

re
4 façons parmi beaucoup d'autres encore

teste les 4 userforms
Pièce jointe 321012
10/11/2018, 18h43
blackmath62

Merci beaucoup trés content

super la macro, perso chez moi, il n'y a que la userform 3 qui passe, sous excel 2010,

merci beaucoup