|
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
124787 번 글에, 함수를 사용할 때 VBA가 실행이 안 돼요..
라는 제목으로 질문 올렸었는데요,
내용이 명확하지 않은 것 같아 다시 질문 올립니다.
8일 간격으로 반복되는 일정이 있어
MOD 함수를 사용하여 8일마다 "안" 이라는 글자가 뜨도록
만들어놨습니다.
필요한 이미지는 "안.jpg" 로 저장해놨구요.
그리고 선택한 폴더 내에 있는 이미지와
셀의 내용이 일치하면 자동으로 불러오게 하는 VBA 를 사용하였는데,
1) MOD 함수를 써서 "안" 이라는 글자가 뜨게 하거나
2) ="안" 이렇게 써서 "안" 이라는 글자가 뜨게 하는 경우에는
이미지가 불러와지지를 않고,
3) "안" 이라는 딱 한 글자만 쓰는 경우에만
이미지가 불러와집니다.
제가 원하는 것은 8일 간격으로
특정한 하나의 이미지를 자동으로 불러오는 것입니다.
1), 2)의 방법을 사용했을 때에는 왜 이미지를 불러올 수 없는 건가요??
1)의 방법을 사용했을 때에도, 지금 쓰고 있는 VBA로 이미지를 불러올 수 있는 방법은 없을까요??
혹시 제가 지금의 엑셀 기능으로는 할 수 없는 일을 하려고 하는 건가요??
==============[이정혜님 글에 대한 답변입니다]==============
VBA를 아래와 같이 수정했습니다.
Sub insert_Pictures_Matching_Name()
Dim fileName As String '각 파일 이름을 넣을 변수
Dim strPath As String '폴더의 경로를 넣을 변수
Dim C As Range '검색에 일치한 셀을 넣을 변수
Dim strName As String '파일 확장자 제외한 이름을 넣을 변수
' ------- 임시주소를 넣을 변수
Dim sAddr As String
Application.ScreenUpdating = False '화면 업데이트 (일시) 정지
With Application.FileDialog(msoFileDialogFolderPicker) '폴더선택 창에서
.Show '폴더 선택창 띄우기
If .SelectedItems.Count = 0 Then '취소 선택 시
Exit Sub '매크로 중단
Else
strPath = .SelectedItems(1) & "\" '폴더 경로를 변수에 넣음
End If
End With
ActiveSheet.Pictures.Delete '기존 사진들 삭제
fileName = Dir(strPath) '(폴더내)각 그림파일 이름을 변수에 넣음
If fileName = "" Then '폴더에 파일이 없으면
MsgBox "폴더에 파일이 없습니다." '메시지 출력
Exit Sub '매크로 중단
End If
Do While fileName <> "" '이름이 없지 않다면, 즉, 파일이 존재하면
strName = Split(fileName, ".")(0) '파일 확장자 제거한 이름 추출
' ------- Find 메소드 변수 추가 및 구문 수정
Set C = ActiveSheet.UsedRange.Find(strName, , xlValues, xlWhole) '그림파일과 일치하는 셀을 찾음
If Not C Is Nothing Then '그림파일과 동일한 이름이 셀에 존재하면
sAddr = C.Address
Do
ActiveSheet.Pictures.Insert(strPath & fileName).Select '각 그림파일 삽입
'Set C = C.Next.MergeArea '셀병합 셀을 C에 넣음
With Selection '선택된 그림파일
.Name = "Temp" '복사된 사진의 이름을 변경
.ShapeRange.LockAspectRatio = msoFalse '그림의 가로/세로비율 고정 해제
.Height = C.Resize(2, 2).Height '그림의 가로크기 지정
.Width = C.Resize(2, 2).Width '그림의 세로크기 지정
.Copy '그림을 복사
ActiveSheet.PasteSpecial Link:=False
'그림 링크깨고 붙여넣기
ActiveSheet.Pictures("Temp").Delete '원본 그림파일 삭제
End With
With Selection '(복사되어)선택된 그림파일
.Left = C.Left '그림의 왼쪽위치 지정
.Top = C.Top '그림의 윗쪽위치 지정
End With
Set C = ActiveSheet.UsedRange.FindNext(C)
Loop While Not C Is Nothing And C.Address <> sAddr
End If
fileName = Dir '다음 파일을 파일이름에 넣음
Loop '무한 반복
End Sub
|
|