Как отобразить URL-адрес в виде изображения в ячейке Excel?

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

Если у вас есть набор ссылок в столбцеДж.нравиться:

и вы запускаете этот короткий макрос 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. АЛЬТ-Ф8
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