vba - Excel 将 URL 转换为图像 (1004)

Question

我有一个链接到 SQL 数据库的 Excel 文档，其中包含多列图像 URL。

其中一个 URL 如下所示: https://imissit.blob.core.windows.net/iris/596480cf967e0c990c37fba3725ada0c/814040e2-0ccb-4b05-bdb3-d9dc9cc798d9/texture.png

我发现了关于如何将这些 URL 转换为图像的不同方法和方法(例如 Excel VBA Insert Images From Image Name in Column和 https://superuser.com/questions/940861/how-can-i-display-a-url-as-an-image-in-an-excel-cell )在 Excel 文档中使用宏。我尝试了这些方法，但它们都不适合我的 URL 类型。我尝试了其他 URL(网络上的随机图像、http 和 https，对于这些图像，它可以工作)。

这是我尝试过的片段之一，适用于其他图像:

   Sub InstallPictures()
    Dim i As Long, v As String
    For i = 2 To 2
        v = Cells(i, "O").Value
        If v = "" Then Exit Sub
        With ActiveSheet.Pictures
            .Insert (v)
        End With
    Next i
End Sub

无论如何，当使用我的 URL 尝试它时，我收到运行时错误 1004:无法执行图片对象的插入方法(已翻译)。不同的方法导致运行时错误略有不同(尽管 1004 是一致的)。

以下是我尝试过的一些图像 URL:

https://docs.oracle.com/cd/E21454_01/html/821-2584/figures/HTTPS_Collab_Sample.png

http://www.w3schools.com/css/paris.jpg

https://scontent.ftxl1-1.fna.fbcdn.net/v/t1.0-9/13043727_278733959131361_2241170037980408109_n.jpg?oh=bec505696c5f66cde0cc3b574a70547c&oe=58CC35C5

我的 URL 与其他 URL 有何不同？为什么这些方法不起作用？正确的做法是什么？

Answer 1

问题(据我所知)不是您的设备，而是在托管图像的服务器上，并且无法返回文档。我不确定上面 Tim 的评论(与 206 响应代码有关)来自哪里，但如果是这种情况，或者 URL 返回一些错误代码，那么您的 VBA 也会失败，并且可能什么也没有如果问题出在主机上，您可以解决该问题。

我今天手动输入网址并下载文件，没有问题。

我检查了response code它正确返回 200(成功)。

此时您能做的最好的事情就是简单地捕获错误，并将其标记为供以后检查。

在我的测试中，我故意使用了一些错误的 URL，只是为了确保错误处理按预期工作。这些是唯一对我来说失败的。

这是我使用的代码，仅对您的代码稍作修改，并包含一个错误处理程序，用于向 URL 返回错误的单元格添加 COMMENT。这样您就可以稍后手动查看并根据需要添加这些图像。

Sub InstallPictures()
    Dim i As Long
    Dim v As String
    Dim cl As Range
    Dim pic As Shape
    Dim errors As New Collection

    i = 2
    Set cl = Cells(i, 15)
    Do While Trim(cl.Value) <> vbNullString
        v = Trim(cl.Value)
        cl.ClearComments

        With ActiveSheet.Pictures
            On Error GoTo ErrHandler
            Set p = .Insert(Trim(v))
            On Error GoTo 0
            ' I added this code to resize & arrange the pictures
            ' you can remove it if you don't need it
            p.TopLeftCell = cl.Offset(0, -1)
            p.Top = cl.Offset(0, -1).Top
            p.Left = cl.Offset(0, -1).Left
            p.Height = Cells(i, 15).Height
            p.Width = Cells(1, 15).Width
            '''''''''''''''''''''''''''''
        End With

NextCell:
        i = i + 1
        Set cl = Cells(i, 15)
    Loop

    If errors.Count > 0 Then
        MsgBox "There were errors, please review the comments as some files may need to be manually downloaded"
    End If

    Exit Sub


ErrHandler:
    Call ErrorNote(v, cl, errors)
    Resume NextCell
End Sub

Private Sub ErrorNote(url$, cl As Range, ByRef errs As Collection)
' Adds an item to the errs collection and flags the offending
' cell with a Comment indicating the error occurred. 
    On Error Resume Next
    errs.Add (url)
    With cl
        .ClearComments
        .AddComment ("Error with URL: " & vbCrLf & url)
    End With
End Sub