엑셀 매크로 (VB) 를 이용하여 여러개의 그림 (사진) 및 파일 이름 정리하기

참고 : http://blog.naver.com/xogari/140068629579

 하나의 Page에 여러개의 작은 사진이나 그림과 그 파일명을 함께 쓰도록 작성한
엑셀 매크로이다.

아래의 매크로를 module에 추가하고 실행시키면 된다.

주의할 것은 
1) 아래의 매크로 중에서 폴더명은 자신의 폴더명으로 변경
2) Sheet1의 A열에 폴더안에 있는 파일명을 넣었음
3) Sheet2에서 매크로를 실행했음

=======================================================================================================
Option Explicit
 
    Const iRow          As Long = 491     ' 세로로 몇장의 사진
    Const iCol          As Long = 5     ' 가로로 몇장의 사진
    Const cntRow        As Long = 6    ' 사진이 들어갈 로우의 수
    Const cntCol        As Long = 2     ' 사진이 들어갈 칼럼의 수
    Const startRow      As Long = 3    ' 사진이 들어가는 첫셀의 로우값
    Const startCol      As Long = 1     ' 사진이 들어가는 첫셀의 칼럼값
  
Sub Insert_Picture()

    Dim myFolder        As String       ' 사진이 저장되어 있는 폴더
    Dim myFile          As String       ' 사진 파일 이름
    Dim myFile1          As String       ' 사진 파일 이름
    Dim C As Range ' 범위 개체 변수
    Dim n As Long ' 숫자형 변수
    Dim i As Long ' 숫자형 변수
    Dim count As Long ' 숫자형 변수
   
    Worksheets("Sheet2").Activate
  

    count = 0
    Application.ScreenUpdating = False '매크로가 진행되는 동안 화면갱신을 하지 않음
  
    myFolder = "C:\이미지폴더\" ' 사진 폴더 지정
  
    For n = 1 To iRow   ' 세로로 사진이 들어갈 숫자만큼 순환
   
        For i = 1 To iCol  ' 가로로 사진이 들어갈 숫자만큼 순환
          
            Set C = Cells(startRow + n * cntRow - cntRow, startCol + i * cntCol - cntCol) ' 사진 이름이 있는 셀 지정
          
            count = count + 1
            myFile = Worksheets("Sheet1").Cells(count, 1)  ' 사진 이름을 지정
           
            myFile1 = myFolder & myFile
            'Cells(count, 1) = myFile1
            Set C = C.MergeArea ' 사진이 들어갈 대지 지정
            
            With ActiveSheet.Pictures.Insert(myFile1).ShapeRange ' 사진 입력
                   '  ---------- 사진 위치 조정 ----------------------
                '.LockAspectRatio = msoFalse   ' 원래 사진 비율 해제
                .Height = C.Height   ' 사진 높이를 셀 크기보다 6 작게
                .Width = C.Width    ' 사진 너비도..
                .Left = C.Left ' 사진의 왼쪽 위치는 3으로(6/2)
               .Top = C.Top ' 사진의 윗쪽 위치도...
            End With
           
            Cells(startRow + n * cntRow - 3, startCol + i * cntCol - cntCol) = Worksheets("Sheet1").Cells(count, 2)
       
        Next
      
    Next
  
    Application.ScreenUpdating = True   ' 화면갱신
  
End Sub

=================================================================================================