Как я могу отобразить 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

Если у вас есть набор ссылок в столбце 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

Каждая из ссылок будет открыта, и соответствующий рисунок будет размещен на листе.

Картинки должны быть правильного размера и расположены.

EDIT # 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

Макросы должны быть включены, чтобы это работало!

EDIT # 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 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

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 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