PDA

View Full Version : Solved: Using image URL to pull image into specific cell - excel 2007



DiamondNate
12-21-2012, 01:31 PM
Hello

I have an image URL on Worksheet("Company Info") E2 and am stumped on how to right a VBA to pull the image behind the URL to Worksheet("US") H23.

I am using Excel 2007 and am just in the beginning phases of understanding VBA.

Any help would be greatly appreciated. Thanks!

Kenneth Hobs
12-21-2012, 07:41 PM
Please post an example file.

DiamondNate
12-21-2012, 11:41 PM
Here is an example:
http://catalogs.infocommiq.com/avcat/images/company/206548medium.gif

Kenneth Hobs
12-22-2012, 05:24 AM
I can easily do it with a url. What I needed was how to retrieve it from what you have.

The method download a url was posted in: http://www.vbaexpress.com/forum/showthread.php?t=34206

DiamondNate
12-22-2012, 05:32 AM
I appreciate your response Kenneth. I am not sure I am following what you are asking for. The file is not anywhere on my computer just behind the URL. Attached is the file I am using. All images will always be the same size so I do not need to re-size them. Just need to pull them in. Thanks for your help.

I will read up on the URL you have suggested.

Kenneth Hobs
12-22-2012, 07:03 AM
I did not know if the url was in a hyperlink, formula, object, or just text in a cell as it appears. The link that I showed does what you need. If you need more help, post back or mark the thread solved if you figured it out.

DiamondNate
12-22-2012, 03:00 PM
My apologies Kenneth

Yes the URL is text in Worksheet("Company Info") E2 and I would like this to center itself in Worksheet("US") G23:I26 without changing the current size of the cells. All images will be 150 x 75 pixels and should have no problem fitting in those cells.

Looking at the VBA on the link it seems to be resizing the image and a URL already set in place. Not sure where/how to place the location where the text URL would be coming from and how to direct this image to show up in several worksheets (US, EMEA, Asia and Oceania). Thought I was further along with VBA but can totally tell I am still just a noob.

Maybe I am in over my head but any help would be greatly appreciated. Thanks.

Kenneth Hobs
12-22-2012, 11:15 PM
I hardcoded the function to use a pixel to point conversion for that image.

Play AddLogos from the module mAddLogos in the Visual Basic Editor, VBE.

DiamondNate
12-23-2012, 12:13 AM
Oh wow. Not sure I would have figured all that out.

Thanks Kenneth!

snb
12-23-2012, 10:04 AM
or:


for each sh in Array("US","EMEA", "Asia", "Oceania")
with sheets(sh)
.Shapes.AddPicture sheets("Company info").cells(2,5).value , True, True, .columns(7).Left, .rows(23).Top, .columns(10).left-.columns(7).left, .rows(27).top-.rows(23).top
end with
next

Kenneth Hobs
12-23-2012, 10:09 AM
I tweaked the routines to make it run faster and only download the file once.

In the mAPI, replace this with this function.
Function AddPictureUrl(sSourceURl As String, sFilename As String, picR As Range, _
Optional tfDelTemp As Boolean = False) As Shape
Dim sLocalFile As String, s As Shape, tf As Boolean

On Error GoTo err_h

'Create a temp filename.
sLocalFile = Environ("tmp") & "\" & sFilename
'Set the file attributes
SetFileAttributes sLocalFile, FILE_ATTRIBUTE_TEMPORARY

'Attempt to delete any cached version of the file.
DeleteUrlCacheEntry sSourceURl

'Delete temp file if it exits.
If (Dir(sLocalFile) <> "" And tfDelTemp = True) Then Kill sLocalFile

tf = DownloadFile(sSourceURl, sLocalFile)
'While Not (tf)
'DoEvents
'Wend
If tf = True Then
'Set AddPictureUrl = ActiveSheet.Shapes.AddPicture(sLocalFile, msoFalse, msoTrue, picR.Left, picR.Top, 36, 36)
Set AddPictureUrl = Worksheets(picR.Worksheet.Name).Shapes.AddPicture(sLocalFile, msoFalse, msoTrue, picR.Left, picR.Top, 112.5, 56.25)
If tfDelTemp = True Then Kill sLocalFile
Else
'Create a bogus error
Err.Raise 999
End If

Exit Function
err_h:
Set AddPictureUrl = Nothing
End Function

In the mAddLogos use this.
Sub AddLogos()
Dim s() As Variant, v As Variant, url As String, tFile As String
Dim r As Range, p As Shape
s() = Array("EMEA", "Asia", "Oceania")
url = Worksheets("Company Info").Range("E2").Value
tFile = "logo.gif"
AddPictureUrl url, tFile, Worksheets("US").Range("G23")
tFile = Environ("tmp") & "\" & tFile
For Each v In s()
'AddPictureUrl url, tFile, Worksheets(CStr(v)).Range("G23")
Set r = Worksheets(CStr(v)).Range("G23")
Set p = Worksheets(CStr(v)).Shapes.AddPicture(tFile, msoFalse, msoTrue, r.Left, r.Top, 112.5, 56.25)
Next v
End Sub

Aussiebear
12-23-2012, 10:00 PM
Great work Kenneth

Kenneth Hobs
12-23-2012, 10:30 PM
Flowers are nice, thanks! Sometime, I might write a routine to make the pixels to points conversion more versatile. There are a couple of different ways to get the pixel size without opening the file.

DiamondNate
12-24-2012, 12:18 AM
Kenneth,

Thanks for the continued help. I applied the changes you suggested and get the following errors.
1) An error occurred while importing this file. C:\User... this appears twice
2) Run-time error '1004': Application-Defined or object-defined error

When you click on debug it brings you to this string of code
Set p = Worksheets(CStr(v)).Shapes.AddPicture(tFile, msoFalse, msoTrue, r.Left, r.Top, 112.5, 56.25)

snb
12-24-2012, 02:16 AM
Cfr. the attachment

DiamondNate
12-24-2012, 02:32 AM
snb,

I did see you post and tried your suggestion but received a run-time error 1004

snb
12-24-2012, 03:44 AM
Did you use the attachment I posted in post #15 ?

Kenneth Hobs
12-24-2012, 10:34 AM
You must have tried my 2nd example before I edited it shortly after posting. I most always test my code so it does work. I have attached that latest version.

DiamondNate
12-24-2012, 11:26 PM
Thanks Kenneth.

snb,
I did see you posted and tried your file. Received the same error.