☰

Transforme caminhos de URL em um FORMATO JPG, NÃO em PNG, em inserções de imagens reais no Excel

tag-icon • tag-icon microsoft-excel vba
Transforme caminhos de URL em um FORMATO JPG, NÃO em PNG, em inserções de imagens reais no Excel

Estou lutando para encontrar o código VBA que me ajudaria a transformar caminhos de URL em um FORMATO JPG, NÃO em PNG, em inserções de imagens reais no Excel. Existem vários VBAs por aí que funcionam, mas apenas se os URLs contiverem fotos PNG.

Comecei a acreditar que é basicamente uma limitação do Excel poder exibir fotos de um caminho de URL.

se algum de vocês conhece algum VBA que traga PICS (FORMATO JPG) de um URL PATH para o Excel e coloque cada foto ao lado de seu link, isso seria uma grande ajuda para mim.

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

Esse é um dos links que eu gostaria de fazer isso.

Responder1

O código a seguir funciona para a URL, mas por algum motivo o servidor está bloqueando a URL que você solicitou, podem ser 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

Responder2

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

informação relacionada