Як я можу відобразити URL-адресу як зображення у комірці excel?

Чи можете мені хтось пояснити, як перетворити веб-посилання (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 з них) зображення (розмір комірки 81х81).

Може хтось, будь-ласка, пояснить крок за кроком, як я це можу зробити?

Якщо у вас є набір посилань у стовпці 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

Якщо ви збережете робочу книгу, макрос буде збережено разом із нею. Якщо ви використовуєте версію Excel пізніше 2003 року, ви повинні зберегти файл як .xlsm, а не .xlsx

Щоб видалити макрос:

1. піднести вікно VBE, як вище
2. очистити код
3. закрити вікно VBE

Щоб використовувати макрос з Excel:

1. ALT-F8
2. Виберіть макрос
3. Торкніться RUN

Щоб дізнатися більше про макроси в цілому, див:

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

Цей працює набагато краще тим, що зображення закінчується поруч із коміркою, до якої належить.

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

Це моя модифікація:

• Замінити клітинку посиланням на зображення (не новий стовпець)
• Зробіть збереження зображень разом із документом (замість посилань, які можуть бути крихкими)
• Зробіть зображення трохи меншими, щоб вони мали можливість сортувати їх клітинки.

Код нижче:

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