PNG가 아닌 JPG 형식의 URL 경로를 Excel의 실제 이미지 삽입으로 변환

PNG가 아닌 JPG 형식의 URL 경로를 Excel의 실제 이미지 삽입으로 변환

저는 PNG가 아닌 JPG 형식의 URL 경로를 Excel의 실제 이미지 삽입으로 변환하는 데 도움이 되는 VBA 코드를 찾는 데 어려움을 겪고 있습니다. 작동하는 VBA가 많이 있지만 URL에 PNG Photos가 포함된 경우에만 가능합니다.

나는 기본적으로 URL 경로에서 사진을 표시할 수 있는 것이 Excel의 한계라고 믿기 시작했습니다.

URL PATH에서 (JPG FORMAT) 사진을 가져와서 모든 사진을 링크 옆에 배치하는 VBA를 알고 계시다면 저에게 큰 도움이 될 것입니다.

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

그것이 제가 하고 싶은 링크 중 하나입니다.

답변1

아래의 다음 코드는 URL에 대해 작동하지만 어떤 이유로 서버가 요청한 URL을 차단하고 있습니다. 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

답변2

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

관련 정보