IT

엑셀 이미지url로 실제 사진 보이게 하기

평생업 2021. 1. 25. 12:52

아래 매그로함수 사용

 

Sub URLPictureInsert()
'Updateby Extendoffice 20161116
'Update #1 by Haytham Amairah in 20180104
'Update #2 by Haytham Amairah in 20180108

    Dim Pshp As Shape
    Dim xRg As Range
    Dim xCol As Long
    On Error Resume Next
    Application.ScreenUpdating = False
    Set Rng = ActiveSheet.Range("A2:A140")
    For Each cell In Rng
        filenam = cell
        ActiveSheet.Pictures.Insert(filenam).Select
        Set Pshp = Selection.ShapeRange.Item(1)
        Pshp.Placement = xlMoveAndSize
        If Pshp Is Nothing Then GoTo lab
        xCol = cell.Column + 1
        Set xRg = Cells(cell.Row, xCol)
        With Pshp
            .LockAspectRatio = msoFalse
            .Width = 60
           .Height = 30
            .Top = xRg.Top + (xRg.Height - .Height) / 2
            .Left = xRg.Left + (xRg.Width - .Width) / 2
        End With
lab:
    Set Pshp = Nothing
    Range("A2").Select
    Next
    Application.ScreenUpdating = True
End Sub