Transform URL Paths under a JPG FORMAT NOT a PNG to actual image insertions on excel

Question 1

I am struggling to find the VBA Code that would help me out to be able to Transform URL Paths under a JPG FORMAT NOT a PNG to actual image insertions on excel. There are a bunch of VBAs out there that work but only if the URLs contain PNG Photos.

I started to believe that it’s basically an excel limitation to be able to display pics from an URL path.

if any of you guys know any VBA that would bring (JPG FORMAT) PICS from an URL PATH to excel and place every and each photo beside its link that would be a big help for me.

https://viewworld-files-console.s3.amazonaws.com/assets/113441/preview/IMG_20190327_151722.jpg

That’s one of the links I would wanna do that to.

Question 2

The following code below works for the URL, but for some reason the server is blocking the URL you requested, it could be Amazon Web Servers?

Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
On Error Resume Next
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A2:A5")
For Each cell In Rng
filenam = cell
ActiveSheet.Pictures.Insert("https://images.pexels.com/photos/302743/pexels-photo-302743.jpeg").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("A2").Select
Next
Application.ScreenUpdating = True

Question 3

Dim Pshp As Shape
Dim xRg As Range
Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("A2:A5")
    For Each cell In Rng
    filenam = cell
    ActiveSheet.Pictures.Insert("https://cdn.pixabay.com/photo/2018/02/07/20/58/girl- 
    3137998_960_720.jpg").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("A2").Select
    Next
    Application.ScreenUpdating = True

Leave a Reply Cancel reply