如何在 Excel 儲存格中將 URL 顯示為圖像？

Question

有人可以向我解釋一下如何將網頁連結 (URL) 轉換為圖像嗎？

範例圖像（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

Answer 3

這個效果更好，因為圖像最終位於它所屬的單元格旁邊。

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 rng = ActiveSheet.Range("C1:C3000")   ' <---- ADJUST THIS
    For Each cell In rng
        Filename = cell
        If InStr(UCase(Filename), "JPG") > 0 Then   '<--- ONLY USES JPG'S
            ActiveSheet.Pictures.Insert(Filename).Select
            Set theShape = Selection.ShapeRange.Item(1)
            If theShape Is Nothing Then GoTo isnill
            xCol = cell.Column + 1
            Set xRg = Cells(cell.Row, xCol)
            With theShape
                .LockAspectRatio = msoFalse
                .Width = 100
                .Height = 100
                .Top = xRg.Top + (xRg.Height - .Height) / 2
                .Left = xRg.Left + (xRg.Width - .Width) / 2
            End With
isnill:
            Set theShape = Nothing
            Range("A2").Select
        End If
    Next
    Application.ScreenUpdating = True

    Debug.Print "Done " & Now

End Sub