[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기

넘버에 있는 파일명 찾아 사진넣기(jpg)

 

 

'https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=302833695


'이번에 엑셀 정리하면서
'사진만 수만장을 넣어야 하는데요..
'ex)
'셀 이름: ABC -456
'폴더 내 사진 파일 이름 : ABC-456
'이런식이면
'사진 크기가 셀에 맞게 자동으로 파일명을 찾아서 한번에
'수만장 삽입 되게 할 수 없을까요?
'하나씩 넣으니 너무 오래걸려서요~


'
'Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 땡큐엑셀main()

    Dim StrFile As String
    
    Application.ScreenUpdating = False
    On Error Resume Next '도중 에러 무시
    
    
    For Each ea In Range("A:A")
    
        If ea.Value = "" Then
            Exit For
        Else
        
            '사진파일이 있는 경로를 아래와 같이 주면 됩니다.
            'StrFile = "절대경로" & Target.Value & ".jpg"
            StrFile = "c:\temp\" & ea.Value & ".jpg"
            If Dir(StrFile) <> "" Then '파일유무 체크
        
                ActiveSheet.Pictures.Insert(StrFile).Select '사진넣기
                With Selection
                    .ShapeRange.LockAspectRatio = msoFalse '비율유지 해지
                    .Top = ea.Offset(0, 1).Top      '셀크기에 맞도록 사진 사이즈 조정
                    .Left = ea.Offset(0, 1).Left      '셀크기에 맞도록 사진 사이즈 조정
                    .Width = ea.Offset(0, 1).Width      '셀크기에 맞도록 사진 사이즈 조정
                    .Height = ea.Offset(0, 1).Height      '셀크기에 맞도록 사진 사이즈 조정

                End With
            
            End If
            
        End If
    
    Next

    Application.ScreenUpdating = True
    
    
    MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
    
End Sub

 

대량이미지넣기-pictures_insert-땡큐엑셀vba.xlsm

0.14MB