inserting images into cell from url in adjacent cell

[stuartnico]

Hello

Calling the VBA Jedi Masters....

Sub GRABIMAGE()
Dim url_column As Range
Dim image_column As Range


Set url_column = Worksheets(1).UsedRange.Columns("A")
Set image_column = Worksheets(1).UsedRange.Columns("B")

Dim i As Long
For i = 1 To url_column.Cells.Count

  With image_column.Worksheet.Pictures.Insert(url_column.Cells(i).Value)

    .Left = image_column.Cells(i).Left
    .Top = image_column.Cells(i).Top
    image_column.Cells(i).EntireRow.RowHeight = 120
 
  End With

Next
End Sub

I use excel 2007 - old but does the job.

Anyway this works to a degree it does seem to take sometime to run but I suspect this is more down to the poor power in my laptop.

It does seek out the URL in column A and Inserts the image into column B at the corresponding cell/row to the image URL.

The only bit that I'm struggling with is how to resize the images so that are scaled down to a thumbnail size.

I'm more into .php than VBA and as an old codger it takes a while for the penny to drop...lol

I cannot take credit for the above as I found it on the net not sure where tbh.

 

[stuartnico]

Yippee

Figured it out....

Sub GRABIMAGE()
Dim url_column As Range
Dim image_column As Range


Set url_column = Worksheets(1).UsedRange.Columns("A")
Set image_column = Worksheets(1).UsedRange.Columns("B")

Dim i As Long
For i = 1 To url_column.Cells.Count

With image_column.Worksheet.Pictures.Insert(url_column.Cells(i).Value)

With .ShapeRange
.LockAspectRatio = msoTrue
.Height = 25
End With

.Left = image_column.Cells(i).Left
.Top = image_column.Cells(i).Top
image_column.Cells(i).EntireRow.RowHeight = 25

End With

Next
End Sub

Just need to work out now how to deal with any images not present.