无法使用 link 在电子表格中插入图片

Question

我在 vba 中编写了一个脚本，它在 column b 中使用了 Url，并在 column c 中紧邻 url 插入图像。该脚本在我使用此 image link but it fails when I use this image link 时有效。即使我使用第二个 link，如何让我的脚本达到目的？

这是我目前的尝试：

Sub InsertImages()
    Dim pics$, myPics As Shape, PicExists As Boolean, cel As Range

    For Each cel In Range("C2", Range("B2").End(xlDown).Offset(0, 1))
        PicExists = False
        pics = cel.Offset(0, -1)

        For Each myPics In ActiveSheet.Shapes
            If myPics.TopLeftCell.Row = cel.Row Then PicExists = True: Exit For
        Next myPics

        If Not PicExists Then
            With ActiveSheet.Pictures.Insert(pics)
                .ShapeRange.LockAspectRatio = msoFalse
                .Width = cel.Width
                .Height = cel.Height
                .Top = Rows(cel.Row).Top
                .Left = Columns(cel.Column).Left
            End With
        End If
    Next cel
End Sub

Post脚本：虽然我上面的脚本可以利用第一个link插入图片，但是图片看起来和源码有很大的不同。 再说清楚一点：图片变肥了

Answer 1

(1) 似乎无法使用 .picures.insert 从亚马逊服务器复制图像 - 这可能是因为亚马逊，而不是 Excel.但是，将其下载为 ADODB.Stream 是可行的，因此这可能是一种解决方法。我用 This answer 中的代码进行了测试，结果成功了。

(2) 您将图像的位置和大小明确设置为 Excel 单元格并要求 AspectRatio不被保留。如果将此设置为 True，Excel 会自动保持宽度和高度之间的比例 - 因此更改宽度也会自动更改高度（反之亦然）。

如果要保持图片的原始大小，请删除设置图片宽度和高度的行：

With ActiveSheet.Pictures.Insert(pics)
   .ShapeRange.LockAspectRatio = msoTrue
   .Top = Rows(cel.Row).Top
   .Left = Columns(cel.Column).Left
End With

如果您想调整图像大小以适合单元格：

With ActiveSheet.Pictures.Insert(pics)
    .ShapeRange.LockAspectRatio = msoTrue
    .Top = Rows(cel.Row).Top
    .Left = Columns(cel.Column).Left
    If .Width / .Height > cel.Width / cel.Height Then
        .Width = cel.Width
    Else
        .Height = cel.Height
    End If
End With

无法使用 link 在电子表格中插入图片

Can't insert picture in a spreadsheet using a link

excel

vba

image

shape