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
|
Option Explicit
Function telecharger_image(ByVal lien_image As String, ByVal destination As String) As Boolean
Dim oXMLHTTP As Object, i As Long, vFF As Long, oResp() As Byte
Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
oXMLHTTP.Open "GET", lien_image, False 'ouvrir la page ou se trouve le fichier
oXMLHTTP.Send 'send request
'attendre que la page soit chargée completement
Do While oXMLHTTP.readyState <> 4
DoEvents
Loop
oResp = oXMLHTTP.responseBody 'retour du resultat dans un byte array
'creation du fichier solide dans sa destination
vFF = FreeFile
If Dir(destination) <> "" Then Kill destination
Open destination For Binary As #vFF
Put #vFF, , oResp
Close #vFF
'vide la memoire
Set oXMLHTTP = Nothing
End Function
Sub TestduCode()
telecharger_image "http://www.google.com/intl/en/images/logo.gif", "C:\google.gif"
ActiveSheet.Pictures.Insert "C:\google.gif"
With ActiveSheet.Shapes(1)
.Name = "google"
.Left = Cells(1, "a").Left + 2
.Width = (Cells(1, "a").Width - 4) * 4 / 3
.Height = Cells(1, "a").Height - 4
.Top = Cells(1, "a").Top + 2
End With
Kill "C:\google.gif"
End Sub |
