Insérer une image Web dans un userform
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:
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
re avec la fonction de comvertion en plus
re
Ok avec la conversion
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
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
;)
