Excel Image.Picture LoadPicture from url

[billboy]

Can anyone help me with this

I am tryin gto Load an image from a website into an image control on my spreadhseet

Private Sub GetPicture()

row = ComboBox1.ListIndex
Dim url As String
url = Worksheets(2).Range("M" & row).Value

Worksheets(3).Image1.Picture = LoadPicture(url)

End Sub

This works if the image is on my hard drive but not with a web url

I get a access error

[His Nibbs]

Call URLDownloadToFile to download the image to your hard drive and then LoadPicture on the local file.

[billboy]

Thanks I will look inot that. As it turns out I dont think I really need to load the picture to an image control I figured out how to size and place it, which was th reason i wanted to use the image control

This seems to work pretty good, but I cant figure out how to delete the previous ppicture if one was already inserted

Private Sub GetPicture()
row = ComboBox1.ListIndex
Dim filename As String
filename = Worksheets(2).Range("M" & row).Value

Dim myPict As Picture
    With ActiveSheet.Range("E25")
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With

I tried this but it doesnt do anything

Private Sub DeletePic()
On Error Resume Next
ActiveSheet.Pictures(myPict).Delete
On Error GoTo 0

which is probably because there is no "myPict until the GetPitccture routine is run.
So I think I need a little help incorporating an IF statement in my GetPicture sub to check if a picture exists and if so delete it

[westconn1]

So I think I need a little help incorporating an IF statement

get a count of the picture objects?

you do not assign a name to the picture object when you insert it, so hard to find again
in the deletepic, mypic has no value, as it is not in scope from the getpicture procedure, if you declare mypic at module level it would still be in scope until excel is closed, unles some other (2nd) picture is assigned to it

[His Nibbs]

delete the previous picture if one was already inserted

    For Each myPict In ActiveSheet.Pictures
        If myPict.TopLeftCell = Range("E25") Then myPict.Delete
    Next

[seenu_1st]

Private Sub GetPicture()
row = ComboBox1.ListIndex
Dim filename As String
filename = Worksheets(2).Range("M" & row).Value

Dim myPict As Picture
    With ActiveSheet.Range("E25")
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Name = "pic"        
myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With

to delete cal this sub

Sub DelImgFrmSht()
Dim sht As Worksheet
Dim shp As Shape
Set sht = Worksheets("Sheet1")
    For Each shp In sht.Shapes
        If shp.Name = "pic" Then
            shp.Delete
        End If
    Next
End Sub

Edited: Call the DelImgFrmSht() before cal getpicture()

[billboy]

    For Each myPict In ActiveSheet.Pictures
        If myPict.TopLeftCell = Range("E25") Then myPict.Delete
    Next

Not quite sure where to place this

I put it in a command button to test it and it returned an error
"Unable to get the TopLeftCell Property of the picture class"

and deleted my command and combobox controls but left the picture

[billboy]

Private Sub GetPicture()
row = ComboBox1.ListIndex
Dim filename As String
filename = Worksheets(2).Range("M" & row).Value

Dim myPict As Picture
    With ActiveSheet.Range("E25")
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Name = "pic"        
myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With

to delete cal this sub

Sub DelImgFrmSht()
Dim sht As Worksheet
Dim shp As Shape
Set sht = Worksheets("Sheet1")
    For Each shp In sht.Shapes
        If shp.Name = "pic" Then
            shp.Delete
        End If
    Next
End Sub

Edited: Call the DelImgFrmSht() before cal getpicture()

It doesnt delete

Private Sub ComboBox1_Change()
Dim row As Integer
row = ComboBox1.ListIndex
Range("E4").Value = Worksheets(2).Range("B" & row).Value & "," & " " & Worksheets(2).Range("C" & row).Value & " " & Worksheets(2).Range("D" & row).Value
Range("E10").Value = Worksheets(2).Range("E" & row).Value & " " & Worksheets(2).Range("F" & row).Value
Range("E11").Value = Worksheets(2).Range("i" & row).Value '& " " & Worksheets(2).Range("F" & row).Value
Range("E6").Value = Worksheets(2).Range("K" & row).Value
DelImgFrmSht
GetPicture
End Sub

Private Sub GetPicture()

row = ComboBox1.ListIndex
Dim filename As String
filename = Worksheets(2).Range("M" & row).Value

Dim myPict As Picture

    With ActiveSheet.Range("E25")
  
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Name = "PropPhoto"
        myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
        
         
    End With
    
With Sheet6.Range("A1")
Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Top = .Top
        myPict.Width = 245 '.Width
        myPict.Height = 175 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With
    
       
End Sub

Private Sub DeletePic()
On Error Resume Next
Worksheets(2).Shapes("PropPhoto").Delete
On Error GoTo 0

End Sub

Sub DelImgFrmSht()
Dim sht As Worksheet
Dim shp As Shape
Set sht = Worksheets(2)
    For Each shp In sht.Shapes
        If shp.Name = "PropPhoto" Then
            shp.Delete
        End If
    Next
End Sub

Got it working....

Apparently you have to use the name of the WorkSheet and NOt the index

WorkSheets("The Name") and NOT WorkSheets(2)

Not sure why though yet

[seenu_1st]

upto this code nothing wrong, works fine

Private Sub CommandButton1_Click()
DelImgFrmSht
GetPicture
End Sub

Private Sub GetPicture()
Dim filename As String
filename = "http://excelexperts.com/sites/default/files/logo.jpg"

Dim myPict As Picture
    With ActiveSheet.Range("E25")
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Name = "PropPhoto"
        myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
    End With
End Sub

Sub DelImgFrmSht()
Dim sht As Worksheet
Dim shp As Shape
Set sht = Worksheets(2)
    For Each shp In sht.Shapes
        If shp.Name = "PropPhoto" Then
            shp.Delete
        End If
    Next
End Sub

[billboy]

When I use the sheet index instead of name in the DelImgFrmSht Sub it doesnt work??
Only works when i use the name of the sheet ??

[seenu_1st]

may be sheet index was wrong, why cant u use sheet name?
otherwise u hav to look into the shape for each sheet

[billboy]

Thanks that was exactly it, I had the wrong index. The index apparently goes by the sheet order in the in the workbook how they are tabbed, I thought it was by sheet1 sheet2 in the editor??

Can you show me how to implement handling if there is no picture something like

Private Sub GetPicture()
Dim row As Integer
row = ComboBox1.ListIndex + 2
Dim filename As String
filename = Worksheets("Data").Range("M" & row).Value

If filename Is Nothing Then
  .Range("E25").Value = "No Picture"
  Exit Sub
  
Dim myPict As Picture

    With ActiveSheet.Range("E25")
        Set myPict = .Parent.Pictures.Insert(filename)
        myPict.Name = "PropPhoto"
        myPict.Top = .Top
        myPict.Width = 150 '.Width
        myPict.Height = 150 '.Height
        myPict.Left = .Left
        myPict.Placement = xlMoveAndSize
        End With

[seenu_1st]

i dont understand, what u mean by handling if there is no pic?

[billboy]

if filename is ""

I think I got it with

If filename = "" Then
  ActiveSheet.Range("E25").Value = "No Picture"
  Exit Sub
  End If

[seenu_1st]

yes u can use that and this too, and dont forget to clear "No Picture" when load picture.

If IsEmpty (filename) Then
  ActiveSheet.Range("E25").Value = "No Picture"
  Exit Sub
  End If

[billboy]

yes u can use that and this too, and dont forget to clear "No Picture" when load picture.

If IsEmpty (filename) Then
  ActiveSheet.Range("E25").Value = "No Picture"
  Exit Sub
  End If

I tried that, it doenst work when i ran debug filename actually contains ""
not sure why the cell is empty, perhaps thats something excel does?

[seenu_1st]

doesnt work means?

[billboy]

doesnt work means?

Means it doesnt work. As I described the variable filename contains "" (quotes) even though the cell is empty

So it trys to load a picture, but none exists

[seenu_1st]

can u attach the file? i hav excel 2003 only