이름과 동일한 사진 일괄삽입

📌 1. 사진 삽입 작업 자동화

• 엑셀에 많은 사람이나 상품 이름이 있는 경우, 이름과 일치하는 이미지를 하나씩 직접 삽입하려면 많은 시간이 걸립니다.
• 이 코드는 사용자가 지정한 이름 범위와 사진 폴더 경로를 기반으로 자동으로 해당 셀에 이미지를 삽입합니다.
• 예: 김철수, 홍길동 등의 이름이 엑셀에 있고, 해당 이름의 이미지(김철수.jpg, 홍길동.png)가 폴더에 있을 때 자동으로 해당 셀 옆에 사진을 넣어줍니다.

📌 2. 반복 작업을 줄여 시간 절약

• 수십 개, 수백 개의 이름에 대해 일일이 이미지를 넣는 건 비효율적입니다.
• 이 코드를 사용하면 한 번의 실행으로 모든 셀에 일괄 삽입할 수 있어 업무 속도가 빨라집니다.

📌 3. 다양한 이미지 확장자 지원

• .jpg, .jpeg, .png 등 다양한 확장자를 자동으로 시도하여 더 유연하게 사용할 수 있습니다.
• 파일명이 맞는 한 어떤 확장자든 자동 탐색해 불러옵니다.

📌 4. 이미지 크기 조절 가능

• 사용자가 원하는 대로 이미지 크기를 3가지 옵션 중 선택하여 셀에 잘 맞게 조절할 수 있습니다.
  • 1: 딱 맞게
  • 2: 약간 작게
  • 3: 더 작게

🎯 언제 사용하면 좋을까요?

• 인사부서: 사원 목록에 증명사진 자동 삽입
• 상품관리: 상품 목록에 제품 이미지 자동 삽입
• 출석부: 학생 이름 옆에 얼굴 사진 삽입
• 행사 기획: 참가자 리스트에 사진 포함시키기

Sub InsertPicturesByName()     ' 사용자에게 이름 범위, 사진 삽입 열, 사진 크기, 폴더를 입력받아     ' 해당 이름의 사진을 해당 셀에 맞게 삽입하는 프로시저입니다.     Dim imgShape As shape     Dim targetCell As Range     Dim nameRange As Range     Dim insertColumnRange As Range     Dim imgPath As String     Dim pictureName As String     Dim insertColumn As Integer     Dim imgLeft As Single, imgTop As Single, imgWidth As Single, imgHeight As Single     Dim sizeOption As Integer     Dim fileFound As Boolean          On Error Resume Next     ' 이름이 입력된 범위를 선택     Set nameRange = Application.InputBox("사진 이름이 입력된 범위를 선택하세요", "이름 범위", Type:=8)     If nameRange Is Nothing Then Exit Sub     ' 사진을 삽입할 열을 선택     Set insertColumnRange = Application.InputBox("사진을 입력할 열을 선택하세요", "열 선택", Type:=8)     If insertColumnRange Is Nothing Then Exit Sub     insertColumn = insertColumnRange.Column     ' 사진 크기 설정 옵션 입력     sizeOption = InputBox("사진의 크기를 선택하세요: 1=딱 맞게, 2=조금 작게, 3=더 작게", "크기 옵션", Default:=1)     ' 사진이 저장된 폴더 선택     With Application.FileDialog(msoFileDialogFolderPicker)         .Show         If .SelectedItems.Count = 0 Then Exit Sub         imgPath = .SelectedItems(1) & "\"     End With     ' 이름 범위에 있는 각 셀에 대해 사진 삽입     For Each targetCell In nameRange         pictureName = targetCell.Value         If pictureName = "" Then GoTo NextCell         ' 삽입 대상 셀 계산         Dim targetInsertCell As Range         Set targetInsertCell = targetCell.Offset(, insertColumn - targetCell.Column)         ' 이미지 위치 및 크기 계산         imgLeft = targetInsertCell.Left + (sizeOption * 2) - 2         imgTop = targetInsertCell.Top + (sizeOption * 2) - 2         imgWidth = targetInsertCell.Width - (sizeOption * 4) + 4         imgHeight = targetInsertCell.Height - (sizeOption * 4) + 4         fileFound = False         ' 확장자별로 이미지 삽입 시도         Dim extensions As Variant         extensions = Array(".jpg", ".jpeg", ".png")                  Dim ext As Variant         For Each ext In extensions             If Dir(imgPath & pictureName & ext) <> "" Then                 Set imgShape = ActiveSheet.Shapes.AddPicture( _                     Filename:=imgPath & pictureName & ext, _                     LinkToFile:=msoFalse, _                     SaveWithDocument:=msoCTrue, _                     Left:=imgLeft, _                     Top:=imgTop, _                     Width:=imgWidth, _                     Height:=imgHeight)                                      fileFound = True                 Exit For             End If         Next ext         ' 이미지가 없을 경우 메시지 표시         If Not fileFound Then             MsgBox "이미지를 찾을 수 없습니다: " & pictureName             GoTo NextCell         End If         ' 이미지 테두리 스타일 지정         With imgShape.Line             .Visible = msoTrue             .ForeColor.ObjectThemeColor = msoThemeColorText1             .ForeColor.TintAndShade = 0             .ForeColor.Brightness = 0             .Transparency = 0             .Weight = 0         End With NextCell:     Next targetCell End Sub

 

 

InsertPicturesByName.xlsm

0.11MB