如何在 Excel 单元格中将 URL 显示为图像？

Question

有人可以向我解释如何将网络链接（URL）转换为图像。

示例图片（网址为http://cache.lego.com/media/bricks/5/1/4667591.jpg）

我想要做的是制作一个我下载的零件清单显示图像而不是上面的网络链接。

我在 J2 到 J1903 中的内容是：

http://cache.lego.com/media/bricks/5/1/4667591.jpg
http://cache.lego.com/media/bricks/5/1/4667521.jpg
...

我想要做的是让 excel 将所有这些（其中 10903 个）转换为图片（单元格大小 81x81）。

有人可以一步一步解释我如何做到这一点吗？

Answer 1

如果您在J列中有一组链接，例如：

然后运行这个简短的 VBA 宏：

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

每个链接都将被打开，相关的图片将被放置在工作表上。

图片的大小和位置必须正确。

编辑#1：

宏非常易于安装和使用：

1. ALT-F11 调出 VBE 窗口
2. ALT-I ALT-M 打开一个新模块
3. 粘贴内容并关闭 VBE 窗口

如果您保存工作簿，宏将与它一起保存。如果您使用的是 2003 年以后的 Excel 版本，则必须将文件另存为 .xlsm 而不是 .xlsx

要删除宏：

1. 调出如上的 VBE 窗口
2. 清除代码
3. 关闭 VBE 窗口

要使用 Excel 中的宏：

1. ALT-F8
2. 选择宏
3. 触摸运行

要了解有关一般宏的更多信息，请参阅：

http://www.mvps.org/dmcritchie/excel/getstarted.htm

和

http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx

必须启用宏才能使其工作！

编辑#2：

为避免因检索错误而停止，请使用此版本：

Sub InstallPictures()
    Dim i As Long, v As String
    On Error Resume Next
        For i = 2 To 1903
            v = Cells(i, "J").Value
            If v = "" Then Exit Sub
            With ActiveSheet.Pictures
                .Insert (v)
            End With
        Next i
    On Error GoTo 0
End Sub

Answer 2

这是我的修改：

• 将单元格替换为带图片的链接（不是新列）
• 使图片与文档一起保存（而不是可能脆弱的链接）
• 使图像稍微小一些，以便它们有机会用细胞进行排序。

代码如下：

Option Explicit
Dim rng As Range
Dim cell As Range
Dim Filename As String

Sub URLPictureInsert()
    Dim theShape As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    ' Set to the range of cells you want to change to pictures
    Set rng = ActiveSheet.Range("A2:A600")  
    For Each cell In rng
        Filename = cell
        ' Use Shapes instead so that we can force it to save with the document
        Set theShape = ActiveSheet.Shapes.AddPicture( _
            Filename:=Filename, linktofile:=msoFalse, _
            savewithdocument:=msoCTrue, _
            Left:=cell.Left, Top:=cell.Top, Width:=60, Height:=60)
        If theShape Is Nothing Then GoTo isnill
        With theShape
            .LockAspectRatio = msoTrue
            ' Shape position and sizes stuck to cell shape
            .Top = cell.Top + 1
            .Left = cell.Left + 1
            .Height = cell.Height - 2
            .Width = cell.Width - 2
            ' Move with the cell (and size, though that is likely buggy)
            .Placement = xlMoveAndSize
        End With
        ' Get rid of the 
        cell.ClearContents
isnill:
        Set theShape = Nothing
        Range("A2").Select

    Next
    Application.ScreenUpdating = True

    Debug.Print "Done " & Now

End Sub