Excel 셀에 URL을 이미지로 표시하려면 어떻게 해야 합니까?

Excel 셀에 URL을 이미지로 표시하려면 어떻게 해야 합니까?

누군가 웹 링크(URL)를 이미지로 변환하는 방법을 나에게 설명해 주실 수 있나요?

예시 이미지(URL은 http://cache.lego.com/media/bricks/5/1/4667591.jpg)

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

내가 하고 싶은 것은 이 모든 것(10903개)을 그림(셀 크기 81x81)으로 변환하는 것입니다.

누군가 내가 이 작업을 수행하는 방법을 단계별로 설명해 주시겠습니까?

답변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 창을 닫습니다.

통합 문서를 저장하면 매크로도 함께 저장됩니다. 2003 이후 Excel 버전을 사용하는 경우 파일을 .xlsx가 아닌 .xlsm으로 저장해야 합니다.

여기에 이미지 설명을 입력하세요

매크로를 제거하려면:

  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

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

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

관련 정보