|
|
 |
 |
|
 |
|
|
| |
|
|
| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
이리저리 해봤는데도 안 돼서 다시 한 번 질문 드립니다ㅠㅠ
8일 주기로 반복되는 일정("안")은
수정해주신 VBA로 이미지("안.jpg") 불러오기가 잘 됩니다.
그런데 명절과 같이 비주기적인 기념일을 표시하기 위해
=IF(COUNTIF(기념일!D100:D111,DATE(YEAR(AA22),MONTH(AA22),DAY(AA22)))>0,"명","")
이러한 함수를 통해 "명"이 뜨도록 설정해놓았는데,
폴더에 "명.jpg" 파일이 있어도,
"명.bmp" 또는 "명.png" 파일이 있어도
이미지가 불러와지지 않고,
"명" 이 아닌 다른 텍스트로 시도해봐도 안 되더라구요...
그런데 함수를 다 지우고
"명"자만 썼을 경우에는 VBA 를 실행했을 때,
"명.jpg" 만 불러와지고 ("안.jpg"는 불러오지 않음)
91 런타임 오류 메시지가 뜹니다.
"개체 변수 또는 With 문의 변수가 설정되어 있지 않습니다"
그리고 디버그를 누르면
Loop While Not C Is Nothing And C.Address <> sAddr
이 부분이 노란색으로 표시가 돼요.
혹시 지금 사용하고 있는 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
|
|
|
[불량 게시물 신고]
|
|
|
|
|
작성일 : 2018-10-11(13:58)
최종수정일 : 2018-10-11(13:58) |
| |
|
 |
|
|
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
