Excel Image.Picture LoadPicture from url

Can anyone help me with this

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

HTML Code:

---

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

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

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

Code:

---

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

Code:

---

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

Quote:

---

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

Quote:

---

Originally Posted by billboy

delete the previous picture if one was already inserted

---

Code:

---

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

---

Code:

---

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

Code:

---

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()

Quote:

---

Originally Posted by His Nibbs

Code:

---

    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

Quote:

---

Originally Posted by seenu_1st

Code:

---

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

Code:

---

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

Code:

---

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

upto this code nothing wrong, works fine

Code:

---

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

---

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 ??

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

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

Code:

---

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

---

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

if filename is ""

I think I got it with

Code:

---

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

---

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

Code:

---

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

---

Quote:

---

Originally Posted by seenu_1st

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

Code:

---

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?

doesnt work means?

Quote:

---

Originally Posted by seenu_1st

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

can u attach the file? i hav excel 2003 only