☰

将 JPG 格式（而非 PNG 格式）下的 URL 路径转换为 ​​Excel 上的实际图像插入

tag-icon • tag-icon microsoft-excel vba
将 JPG 格式（而非 PNG 格式）下的 URL 路径转换为 ​​Excel 上的实际图像插入

我正在努力寻找 VBA 代码，以便能够将 JPG 格式（而非 PNG）下的 URL 路径转换为 ​​Excel 上的实际图像插入。有很多 VBA 可以工作，但前提是 URL 包含 PNG 照片。

我开始相信，从 URL 路径显示图片基本上是 Excel 的限制。

如果你们当中有谁知道任何 VBA 可以将（JPG 格式）图片从 URL 路径带到 Excel 并将每张照片放在其链接旁边，那么这对我将有很大帮助。

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

这是我想要做的链接之一。

答案1

下面的代码适用于该 URL，但由于某种原因，服务器阻止了您请求的 URL，可能是 Amazon Web 服务器？

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

相关内容