Solved

LOAD AN IMAGE FROM AN URL ADDRESS ON A USERFORM OBJECT

Posted on 2014-02-18
5
1,706 Views
Last Modified: 2014-02-19
VBA EXCEL 2010
Userform

Is there a control in Excel other then the "image control" where i could load a picutre from a url address ...?

or someother way to display an image from a url address ?

Thanks
fordraiders
0
Comment
Question by:fordraiders
  • 4
5 Comments
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39869487
The most simple way is to use the web browser control.
For example:
Private Sub UserForm_Initialize()
    WebBrowser1.Navigate ("http://www.indexoncensorship.org/wp-content/uploads/2012/09/EU_Flag.jpg")
End Sub

Open in new window

0
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39869572
The other option is to use a image control, download the file to local disk and then load it in the image control.

Put this in a standard module:
Option Explicit

Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
 ByVal sProxyBypass As String, ByVal lFlags As Long) As Long

Public Declare Function InternetOpenUrl Lib "wininet.dll" Alias "InternetOpenUrlA" _
(ByVal hOpen As Long, ByVal sUrl As String, ByVal sHeaders As String, _
 ByVal lLength As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long

Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hfile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
 ByRef lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetReadBinaryFile Lib "wininet.dll" Alias "InternetReadFile" _
(ByVal hfile As Long, ByRef bytearray_firstelement As Byte, ByVal lNumBytesToRead As Long,
 ByRef lNumberOfBytesRead As Long) As Integer

Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer

Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hOpen As Long, ByVal infotype As Long, _
 ByVal buffer As String, ByRef bufferlength As Long, ByVal Index As Long) As Long

Public Const NO_ERROR = 0             ' No error
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0

' Call function with URL and file name
Public Function getBinaryFile(url As String, fileName As String) As Boolean
    Dim hOpen As Long
    Dim hOpenUrl As Long
    Dim retval As Long
    Dim fileSize As Long
    Dim byteArray() As Byte
    Dim bufflen As Long
    Dim databuff As String * 8
    Dim bytesread As Long
    Dim intFile As Integer
    Dim isOpen As Boolean

    On Error GoTo errhandler

    bufflen = Len(databuff)
    hOpen = InternetOpen("myconn", INTERNET_OPEN_TYPE_PRECONFIG, 0, 0, 0)
    hOpenUrl = InternetOpenUrl(hOpen, url, 0, 0, INTERNET_FLAG_RELOAD, 0)

    If hOpenUrl > 0 Then
        retval = HttpQueryInfo(hOpenUrl, 5, databuff, bufflen, 0)

        If retval > 0 Then
            fileSize = databuff

            ReDim byteArray(fileSize + 1) As Byte

            retval = InternetReadBinaryFile(hOpenUrl, byteArray(0), fileSize, bytesread)
            If (retval > 0) Then
                intFile = FreeFile

                Open fileName For Binary As #intFile
                isOpen = True
                Put #intFile, , byteArray
                Close #intFile

                isOpen = False
            End If
        End If
    End If

    getBinaryFile = True

errhandler:
    If Err.Number <> 0 Then
        getBinaryFile = False
    End If

    On Error Resume Next
    If hOpenUrl > 0 Then InternetCloseHandle (hOpenUrl)
    If hOpen <> 0 Then InternetCloseHandle (hOpen)

    If isOpen Then Close #intFile
End Function

Open in new window


And this in the userform:
Private Sub UserForm_Initialize()
    Dim url_path As String
    Dim file_path As String
    
    url_path = "http://www.indexoncensorship.org/wp-content/uploads/2012/09/EU_Flag.jpg"
    file_path = ThisWorkbook.Path & "\" & "Image.png"
    
    ' Download picture
    getBinaryFile url_path, file_path

    ' Load picture
    With Image1
        .Picture = LoadPicture(file_path)
    End With
    
    ' Delete Saved file
    Kill file_path
End Sub

Open in new window

0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39869584
Another way you can download the picture is with this code (replace the code in the standard module with this):
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

Public Function DownloadFilefromWeb(url As String, fileName As String) As Boolean
    DownloadFilefromWeb = URLDownloadToFile(0, url, fileName, 0, 0)
End Function

Open in new window


And the code in the userform with this:
Private Sub UserForm_Initialize()
    Dim url_path As String
    Dim file_path As String
    
    url_path = "http://www.indexoncensorship.org/wp-content/uploads/2012/09/EU_Flag.jpg"
    file_path = ThisWorkbook.Path & "\" & "Image.png"
    
    ' Download picture
    DownloadFilefromWeb url_path, file_path

    ' Load picture
    With Image1
        .Picture = LoadPicture(file_path)
    End With
    
    ' Delete Saved file
    Kill file_path
End Sub

Open in new window

0
 
LVL 3

Author Closing Comment

by:fordraiders
ID: 39870061
perfect Thanks very very much !
0
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39870111
You're welcome.
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
INDEX and MATCH can be used to great effect to replace HLOOKUP and VLOOKUP as it does not have the limitation of needing the data to be sorted so that the reference value is in the first column or row. It also has the ability to perform a bi-directi…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now