☰

Transforme las rutas URL en un FORMATO JPG, NO en PNG, en inserciones de imágenes reales en Excel

tag-icon • tag-icon microsoft-excel vba
Transforme las rutas URL en un FORMATO JPG, NO en PNG, en inserciones de imágenes reales en Excel

Estoy luchando por encontrar el código VBA que me ayude a poder transformar rutas URL en un FORMATO JPG, NO en PNG, en inserciones de imágenes reales en Excel. Hay un montón de VBA que funcionan, pero solo si las URL contienen fotos PNG.

Empecé a creer que es básicamente una limitación de Excel poder mostrar imágenes desde una ruta URL.

Si alguno de ustedes conoce algún VBA que pueda traer FOTOS (FORMATO JPG) de una RUTA URL para sobresalir y colocar todas y cada una de las fotos al lado de su enlace, eso sería de gran ayuda para mí.

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

Ese es uno de los enlaces con los que me gustaría hacer eso.

Respuesta1

El siguiente código funciona para la URL, pero por alguna razón el servidor está bloqueando la URL que solicitó, ¿podrían ser los servidores web de Amazon?

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

Respuesta2

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

información relacionada