Extract Image from URL


Sub URLPictureInsert()
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("C2:C200")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
If .Width > xRg.Width Then .Width = xRg.Width * 2 / 3
If .Height > xRg.Height Then .Height = xRg.Height * 2 / 3
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("C2").Select
Next
Application.ScreenUpdating = True
End Sub


Notes: 


1. In the above code, A2:A5 is the range of cells which contains the URL addresses you want to extract the images, you should change the cell references to your need.

2. With this code, you can not specify the size of the extracted images to your need.

3. The above code only can extract the actual images into the cells besides your URL column, you can not specify cell to output the images.


------------------------------------------------------------------------------------------------------------------------------------------