|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
사진과 파일명을 불러와 라벨지에 출력한는 매크로를 만드려고 합니다
매크로 실행하면 사진과 파일명이 오른쪽으로 계속 배열되는데
4개의 파일 이후마다 다음줄로 배열되게 할 수는 없을까요
그리고 파일명 앞에 폴더명 함께 나오도록 하고싶습니다
Option Explicit
Sub insert_FileName_With_Pictures()
Dim fileNames As Variant '모든 파일 넣을 배열 변수
Dim i As Long '반복구문에 사용할 변수
Dim var '파일이름 쪼개어 넣을 변수
Dim strName As String '추출한 파일이름 넣을 변수
Dim A As Range '파일이름 들어갈 영역을 넣을 변수
Dim C As Range '그림 들어갈 영역을 넣을 변수
Application.ScreenUpdating = False '화면 업데이트 (일시)정지
Set A = ActiveCell '현재 선택한 셀을 변수에 넣음
fileNames = Application.GetOpenFilename("Picture Files (*.jp*; *.gif; *.png),*.xls", , _
"그림 파일을 선택", MultiSelect:=True) '그림 파일을 선택
If TypeName(fileNames) = "Boolean" Then Exit Sub '취소 선택 시 매크로 종료
For i = 1 To UBound(fileNames) '선택한 파일 개수만큼 반복
var = Split(fileNames(i), "\") '\ 로 전체이름을 나누어 배열에 넣음
strName = var(UBound(var)) '제일 뒤의 파일 이름만 추출
A = strName '추출한 이름을 셀에 뿌림
ActiveSheet.Pictures.Insert(fileNames(i)).Select '각 그림파일 삽입
If A.Offset(-1).MergeCells Then '만약 이름 윗셀이 셀병합 셀이면
Set C = A.Offset(, -1).MergeArea '셀병합 셀을 C에 넣음
Else '셀병합셀 아닐 경우
Set C = A.Offset(, -1) '그냥 바로 윗셀을 C에 넣음
End If
With Selection '선택된 그림파일
.Name = "Temp#" '(임시로) 이름을 "Temp#"로 지정
.ShapeRange.LockAspectRatio = msoFalse '그림의 가로/세로비율 고정 해제
.Height = C.Height - 4 '그림의 가로크기 지정
.Width = C.Width - 4 '그림의 세로크기 지정
.Copy '그림을 복사
ActiveSheet.PasteSpecial Link:=False '그림 링크깨고 붙여넣기
ActiveSheet.Pictures("Temp#").Delete '원본 그림파일 삭제
End With
With Selection '(복사되어)선택된 그림파일
.Left = C.Left + 2 '그림의 왼쪽위치 지정
.Top = C.Top + 2 '그림의 윗쪽위치 지정
End With
Set A = A.Offset(, 2) '이름 들어갈 위치를 오른쪽으로 하나씩 늘려감
Next i
Set A = Nothing '개체변수 초기화(메모리 비우기)
Set C = Nothing
End Sub
|
|