Hello,

the following codes are just one solution, but need a sheet and more...

Put the following in a module:

Public Sub download_Image_from_Label_Caption() ' download from url to folder

Dim imgName As String
Dim urlName As String
Dim UrlHttp As Object
Dim objStream As Object
Dim CurrentFolder As String

If Folder_Download_Img_From_Url = "Error" Then ' folder exist ?
     MsgBox "• Access denied:" & Chr(10) & Chr(10) & "• Unable to locate or create destination folder!", vbCritical, "Critical error"
     Exit Sub
End If

CurrentFolder = Folder_Download_Img_From_Url & ""

imgName = "MyMeteoImg" ' you can change the name

urlName = UserForm1.Label1.Caption ' change to  your userform name & your label name

Set UrlHttp = CreateObject("MSXML2.XMLHTTP.6.0")
Set objStream = CreateObject("ADODB.Stream")

adTypeBinary = 1
objStream.Type = adTypeBinary

sPath = CurrentFolder & imgName & ".jpg"
sURI = urlName

On Error GoTo UrlError
UrlHttp.Open "GET", sURI, False
UrlHttp.send
aBytes = UrlHttp.responseBody
On Error GoTo 0

objStream.Open
objStream.Write aBytes
adSaveCreateOverWrite = 2
objStream.SaveToFile sPath, adSaveCreateOverWrite
objStream.Close

' MsgBox "sucefull"

ExitSub:

     If Not UrlHttp Is Nothing Then Set UrlHttp = Nothing
     If Not objStream Is Nothing Then Set objStream = Nothing

     Exit Sub

UrlError:
     MsgBox "• An error has occurred", vbCritical, "Error"
     Resume ExitSub

End Sub

Public Function Folder_Download_Img_From_Url() As String ' determine if folder exists ? if not create one if is possible

Dim WshShell As Object
Dim fso As Object
Dim SpecialPath As String

Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("scripting.filesystemobject")

SpecialPath = ThisWorkbook.Path

If Right(SpecialPath, 1) <> "" Then
     SpecialPath = SpecialPath & ""
End If

If fso.FolderExists(SpecialPath & "DownloadPictures") = False Then
     On Error Resume Next
     MkDir SpecialPath & "DownloadPictures"
     On Error GoTo 0
End If

If fso.FolderExists(SpecialPath & "DownloadPictures") = True Then
     Folder_Download_Img_From_Url = SpecialPath & "DownloadPictures"
Else
     Folder_Download_Img_From_Url = "Error"
End If

End Function

Public Function PauseInEvent(ByVal Delay As Double) ' WAIT A MOMENT WITH LOOP

Dim TheEndOfTime As Double
TheEndOfTime = Timer + Delay

Do While Timer < TheEndOfTime
     DoEvents
Loop

End Function

put in the userform module:

Private Sub CommandButton1_Click()

Call download_Image_from_Label_Caption
PauseInEvent (0.01) ' (MACRO) to make a pause ' you can change the pause value (this is to prevent PC delays or errors)

Call AddPicture
PauseInEvent (0.01) ' (MACRO) to make a pause ' you can change the pause value (this is to prevent PC delays or errors)

Call UploadPicture

End Sub

Private Sub AddPicture() ' ADD PICTURE FROM PC FOLDER TO SHEET RANGE

Dim ws As Worksheet
Dim imagePath As String
Dim imgLeft As Double
Dim imgTop As Double
Dim shp As Shape
Dim CurrentFolder As String
Dim newSheetName As String
Dim checkSheetName As String

newSheetName = "Folha1" ' change sheet name

'you can remove this part of creating an excel sheet and indicate an excel sheet

On Error Resume Next
checkSheetName = Worksheets(newSheetName).Name
If checkSheetName = "" Then
     Worksheets.Add.Name = newSheetName
End If
On Error GoTo 0

If Folder_Download_Img_From_Url = "Error" Then ' folder exist ? ' you can remove this part and add folder path
     MsgBox "• Access denied:" & Chr(10) & Chr(10) & "• Unable to locate or create destination folder!", vbCritical, "Critical error"
     Exit Sub
End If

CurrentFolder = Folder_Download_Img_From_Url & ""

Set ws = ActiveSheet
Range("A10").Select ' change range if you want

On Error GoTo NoLocalizado:
imagePath = CurrentFolder & "MyMeteoImg.jpg"
imgLeft = ActiveCell.Left
imgTop = ActiveCell.Top

'Width & Height = -1 original size
Set shp = ws.Shapes.AddPicture(Filename:=imagePath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Left:=imgLeft, Top:=imgTop, Width:=-1, Height:=-1)

shp.Name = "myPicture"

If Not shp Is Nothing Then Set shp = Nothing

Exit Sub
NoLocalizado:
     MsgBox Err.Description
     Exit Sub
End Sub

Private Sub DeletePicture() 'DELETE PICTURE IN SHEET IF EXISTS

On Error GoTo NoLocalizado:
Dim myImage As Shape
Set myImage = ActiveSheet.Shapes("myPicture") ' you can change the name
myImage.Delete

Exit Sub

NoLocalizado:

'MsgBox Err.Description
     Exit Sub
End Sub

Private Sub UploadPicture()

Application.ThisWorkbook.Worksheets("Folha1").Select ' (the same sheet with the image)

Dim shp1 As Shape
Dim xchart As ChartObject

Set shp1 = ActiveSheet.Shapes("myPicture")
shp1.Select

Selection.CopyPicture xlScreen
Set xchart = Sheets("Folha1").ChartObjects.Add(0, 1000, 10, 10)
xchart.Name = "testchart"
xchart.Width = Selection.Width
xchart.Height = Selection.Height
Sheets("Folha1").ChartObjects("testchart").Activate
ActiveChart.Paste
ActiveChart.Export ThisWorkbook.Path & Application.PathSeparator & "meteo.jpg"
xchart.Delete

Me.Image1.Picture = LoadPicture(ThisWorkbook.Path & Application.PathSeparator & "meteo.jpg")
Me.Image1.AutoSize = True
Me.Image1.BackStyle = fmBackStyleTransparent
Me.Image1.BorderStyle = fmBorderStyleNone

 

If Not shp1 Is Nothing Then Set shp1 = Nothing

If Not xchart Is Nothing Then Set xchart = Nothing

End Sub

 

you can adapte to your needs

Miguel

Hello,
sorry, I needed to add some parts and I couldn't edit my post


you can replace  in Private Sub UploadPicture()

...
ActiveChart.Export (VBA.Environ("TEMP") & Application.PathSeparator & "meteo.jpg")

...
Me.Image1.Picture = LoadPicture(VBA.Environ("TEMP") & Application.PathSeparator & "meteo.jpg")
...

and if you want, you can delete the image on the excel sheet with Private Sub DeletePicture() 'DELETE PICTURE IN SHEET IF EXISTS


update Private Sub AddPicture() ' ADD PICTURE FROM PC FOLDER TO SHEET RANGE


If Not ws Is Nothing Then Set ws = Nothing  '  place this line in the end after: If Not shp Is Nothing Then Set shp = Nothing 

and lastly, if you don't want files or folders to remain, you can delete everything use this

Private Sub DeleteAll() ' delete all files in the folder & the folder

On Error Resume Next
Kill ThisWorkbook.path & "" & "DownloadPictures*.*" ' delete all files in the folder
RmDir ThisWorkbook.path & "" & "DownloadPictures" ' delete folder (RmDir delete only a empty folder)
On Error GoTo 0

End Sub

 

Miguel

Hi Miguel Santos
It is true that for the moment I have not yet been able to test your project.
But it is also true that as regards working with cells in the excel sheet and a Form Image.
I had managed to do everything a few years ago.
And the difficulty lies in this.
Working only with (L'userform) I also tried to develop a sort of program following an old book of vb6.0 that exploits the bees of windows.
But as always I had to run aground; As I can no longer go on here!

If you have a look at the listing and this:

1° )

'@brief Showing the image with the given path Private Sub showImage(ByVal path As String) LoadPictureGDI Frame1, path End Sub ' Procedure: LoadPictureGDI ' Purpose: Loads an image using GDI+ ' Returns: The image as an IPicture Object Public Sub LoadPictureGDI(ByVal c As Object, ByVal sFilename As String) Dim uGdiInput As GdiplusStartupInput Dim lResult As Long #If VBA7 Then Dim hGdiPlus As LongPtr Dim hGdiImage As LongPtr Dim hBitmap As LongPtr #Else Dim hGdiPlus As Long Dim hGdiImage As Long Dim hBitmap As Long #End If 'Initialize GDI+ uGdiInput.GdiplusVersion = 1 lResult = GdiplusStartup(hGdiPlus, uGdiInput) If lResult = 0 Then 'Load the image lResult = GdipCreateBitmapFromFile(StrPtr(sFilename), hGdiImage) If lResult = 0 Then 'Create a bitmap handle from the GDI image lResult = GdipCreateHBITMAPFromBitmap(hGdiImage, hBitmap, 0) 'Create the IPicture object from the bitmap handle 'and show it in the frame. Set c.Picture = CreateIPicture(hBitmap) 'Tidy up GdipDisposeImage hGdiImage End If 'Shutdown GDI+ GdiplusShutdown hGdiPlus End If End Sub ' Procedure: CreateIPicture ' Purpose: Converts a image handle into an IPicture object. ' Returns: The IPicture object #If VBA7 Then Private Function CreateIPicture(ByVal hPic As LongPtr) As IPicture #Else Private Function CreateIPicture(ByVal hPic As Long) As IPicture #End If Dim lResult As Long Dim uPicInfo As PICTDESC Dim IID_IDispatch As GUID Dim IPic As IPicture 'OLE Picture types Const PICTYPE_BITMAP = 1 ' Create the Interface GUID (for the IPicture interface) With IID_IDispatch .Data1 = &H7BF80980 .Data2 = &HBF32 .Data3 = &H101A .Data4(0) = &H8B .Data4(1) = &HBB .Data4(2) = &H0 .Data4(3) = &HAA .Data4(4) = &H0 .Data4(5) = &H30 .Data4(6) = &HC .Data4(7) = &HAB End With ' Fill uPicInfo with necessary parts. With uPicInfo .Size = Len(uPicInfo) .Type = PICTYPE_BITMAP .hPic = hPic .hPal = 0 End With ' Create the Picture object. lResult = OleCreatePictureIndirect(uPicInfo, IID_IDispatch, True, IPic) ' Return the new Picture object. Set CreateIPicture = IPic End Function

2° ) 

'@author Stephen Bullen, Rob Bovey
'@url http://www.rondebruin.nl/win/s2/win009.htm

'Declare a UDT to store a GUID for the IPicture OLE Interface
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

#If VBA7 Then
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As LongPtr
hPal As LongPtr
End Type

'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As LongPtr
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
'PtrSafe
'Windows API calls into the GDI+ library
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As LongPtr, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As LongPtr = 0) As Long
Private Declare PtrSafe Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As LongPtr, bitmap As LongPtr) As Long
Private Declare PtrSafe Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As LongPtr, hbmReturn As LongPtr, ByVal background As LongPtr) As Long
Private Declare PtrSafe Function GdipDisposeImage Lib "GDIPlus" (ByVal image As LongPtr) As Long
Private Declare PtrSafe Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As LongPtr)
Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#Else
'Declare a UDT to store the bitmap information
Private Type PICTDESC
Size As Long
Type As Long
hPic As Long
hPal As Long
End Type

'Declare a UDT to store the GDI+ Startup information
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type

'Windows API calls into the GDI+ library
Private Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdipCreateBitmapFromFile Lib "GDIPlus" (ByVal filename As Long, bitmap As Long) As Long
Private Declare Function GdipCreateHBITMAPFromBitmap Lib "GDIPlus" (ByVal bitmap As Long, hbmReturn As Long, ByVal background As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal image As Long) As Long
Private Declare Sub GdiplusShutdown Lib "GDIPlus" (ByVal token As Long)
Private Declare Function OleCreatePictureIndirect Lib "oleaut32" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
#End If

################################

As you can see, everything is very complicated; But doable.
The problem is how?

It would be enough for me even just a code that knows how to convert the image with the extension (PNG) to (JPG or BNP) found on my desktop and more would be done.
But I repeat all this should be able to do it?

Hello Thanks Miguel You are still Fantasti for the things you do
Sincere greetings from A: Maurizio

(P: S) I ask to work with L'userform, because if it is true that the form is a form apart from the excel group.
It is also true that you should also be able to create these things without necessarily passing through the excl sheet to be made.

We also take only the concept of the (Calculator) it can be created both using the userform and also using the cells of the excel sheet as if they were Numeric Buttons!
Therefore why not being able to do everything even just using a form for the presentation of the weather forecast; Which draws the other things I have already completed
Only this blessed Image is missing.
Hello my dear
Sooner or later we will do it?

Hi Miguel
I have only tried your project now
And I must say that as always you have overcome yourself.
In that: Now making some changes of the case, I could insert in the Userform another key to delete both the image from the Sheet with the construct (Delete) in case there were more than one (Shapes) and all inside the Object image.
I am quite satisfied in how much at least I start with something concrete; Because of you.
What I did not understand and why if I want to try to recover the image from the DownloadPicture folder (MyImage) by inserting it directly in the (Image) property of the image itself.
It gives me credential error.
While if I recover the one that leaves me on the desktop but exposes it in the Userbox Picturebox

He perhaps because the one in the folder and the same image that is taken from the link then with the format (PNG) while the one displayed on my Desktop has been converted to the format (JPG)?
Anyway, you did a nice job Thanks again for everything You are Il (Vasco Rossi) of computer science.
Bye and have a good day

Hello,

You are welcome,

 

Sorry for the download name of the image, even if the file has (.jpg) in the name, if the source was (.png), it remains in (.png) format...

Change the name of the image to download to (.png)

sPath = CurrentFolder & imgName & ".png"

 

Regards,

 

Miguel

Don't worry Miguel
Thanks anyway!
This is unimportant and important stuff

Even if to be honest; However, I don't need much because: I repeat I would only like to work with the form and not confirm the Excel sheet.
That's all!
Thanks anyway for your help it will certainly be useful in the future.
Bye and have a good day. by Maurizio