Discussion :

[xoff60]

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èces maintenance inter-site (France - Blegique) V4_3.xls

[Theze]

Bonsoir,

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

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

[patricktoulon]

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 :

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

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 :

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

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 :

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

[xoff60]

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

[patricktoulon]

dis moi tu a pas fait le test dans un fichier non enregistrer par hasard? sinon c'est normal thisworkbook.path ne donne rien

[xoff60]

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.


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.