[vba] B열의 셀값과 같은 이미지가 있으면 A열에 영구 삽입하기

728x90

Sub program1472_com()
    ActiveSheet.Pictures.Delete
    Dim fPath As String, fName As String
    fPath = ThisWorkbook.Path & "\이미지폴더\"
    Dim C As Range
    Set C = Columns(2).SpecialCells(2)
    For Each C In C
        fName = Dir(fPath & C & ".*")
        If Len(fName) > 0 Then
            ActiveSheet.Shapes.AddPicture fPath & fName, msoFalse, msoTrue, _
                C.Offset(, -1).Left + 2, _
                C.Offset(, -1).Top + 2, _
                C.Offset(, -1).Width - 4, _
                C.Offset(, -1).Height - 4
        End If
    Next
End Sub