Forum Discussion
Convert image url to actual image in excel
You can easily change the Height and Width to make the images fit the cells.
Try to change the Height from 100 to 30 and the Width from 100 to 60.
.Width = 60
.Height = 30
I got the VBA to work. My questions is there a snippet that can be added to the VBA code to make the image insert into a specif cell? For example, if the url is in cell C3 and I want the image to be in cell D3
- Haytham AmairahJan 07, 2019Silver Contributor
Hi Michael,
The code is already programmed to place the image next to the link in the adjacent cell.
This is the result that I got when I run the code.
Isn't that what you asking for?
- Marcelo_PurchioAug 06, 2020Copper Contributor
The code works for some URL and not for other. Sometimes i need to click and open the URL so it could "read" and output the image on excel.
Could you please help me with this problem?
- Michael LoviceJan 07, 2019Copper Contributor
I finally got it to work. I hadn't changed the insert cell location, just the url cell range.
Now I'm trying to figure out how to get the pics to scale with changing cell size. I've tried the following code https://www.extendoffice.com/documents/excel/4923-excel-picture-move-and-size-with-cells-default.html with no luck yet. Working with VBA is completely new to me. I appreciate your help and patience.
- Haytham AmairahJan 08, 2019Silver Contributor
You can update the code like the following by adding this line to it:
Pshp.Placement = xlMoveAndSize
Sub URLPictureInsert()
'Updateby Extendoffice 20161116
'Update #1 by Haytham Amairah in 20180104
'Update #2 by Haytham Amairah in 20180108
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A2:A140")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert(filenam).Select
Set Pshp = Selection.ShapeRange.Item(1)
Pshp.Placement = xlMoveAndSize
If Pshp Is Nothing Then GoTo lab
xCol = cell.Column + 1
Set xRg = Cells(cell.Row, xCol)
With Pshp
.LockAspectRatio = msoFalse
.Width = 60
.Height = 30
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A2").Select
Next
Application.ScreenUpdating = True
End SubThis will change the property for each image after inserting it to make it move and size with the cell.
- Michael LoviceJan 07, 2019Copper Contributor
That's EXACTLY what I'm looking for. But, When I run the code, the images are not placed inside cells. Would you please share with me the actual code you ran?
Thank you so much!
- Haytham AmairahJan 07, 2019Silver Contributor
I've used the same code as in the link I mentioned before.
Sub URLPictureInsert()
'Updateby Extendoffice 20161116
'Update by Haytham 20180104
Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A2:A140")
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
.Width = 60
.Height = 30
.Top = xRg.Top + (xRg.Height - .Height) / 2
.Left = xRg.Left + (xRg.Width - .Width) / 2
End With
lab:
Set Pshp = Nothing
Range("A2").Select
Next
Application.ScreenUpdating = True
End SubBut I adjusted the Height and Width to make the images fit the cells.
Please note that the code may take up to 5 minutes to finish the process.
Hope that helps