엑셀 조건에 맞게 이미지 삽입 방법 있을까요?

VBA
작성자
tu1541
작성일
2021-10-12 18:04
조회
503
엑셀버전 : 엑셀2016

운영체제 : 윈도우10

첨부파일 있습니다. 조건이 좀 까다롭죠...ㅠㅠ
이미지 파일을 여러장 선택하여 삽입할 때 파일명에 가장 뒤 숫자와 엑셀 이미지 삽입하는 셀 바로 위 행 숫자에 따라 사진이 기입되는 방법이 있을까요?

EX)파일명 호랑이-1, 호랑이-12 두개 파일을 선택 했으면 위 숫자를 보고 1) , 12) 아래 셀에 이미지 삽입
그리고 또 한번 VBA실행하여 고양이-03,05,06,10,13,14,24 선택하여 해당하는 사진 삽입
이후 해당 방식으로 이미지 삽입

스크랩
공유
전체 6

  • 2021-10-14 10:05

    @tu1541

    Sub AutoInsertPic()
    
        Dim regex As Object
        Set regex = CreateObject("VBScript.RegExp")
        regex.Pattern = "([가-힣]+)-([0-9]+)"
        regex.Global = True
        
        imgPath = Application.GetOpenFilename("Picture, *.jpg;*.bmp;*.tif;*.gif;*.png")
        If imgPath = "False" Then: Exit Sub
        
        If regex.Test(imgPath) Then
            Dim rng As Range
            Dim matches As Object, fileName As String, fileNo As Integer
            Set matches = regex.Execute(imgPath)
            
            ' # 예를 들어, 파일경로가 C:\documents...\호랑이-01.jpg 라면..
            ' # 정규식으로 값을 구분하여 가져옴.
            
            fileName = matches(0).SubMatches(0) ' # 호랑이
            fileNo = CInt(matches(0).SubMatches(1)) ' # 01
            
            If fileName = "호랑이" Then
                ' # 파싱한 값이 호랑이 라는 이미지 이름이면, A1:W9 까지 No를 찾음
                Set rng = Range("A1:W9").Find(fileNo)
            ElseIf fileName = "고양이" Then
                ' # 파싱한 값이 고양이 라는 이미지 이름이면, A17:W25 까지 No를 찾음
                Set rng = Range("A17:W25").Find(fileNo)
            End If
            
            If Not rng Is Nothing Then
                ' # index No가 있다면 선택한 이미지 삽입 루틴
                Set rng = Cells(rng.Row + 1, rng.Column)
                With ActiveSheet.Pictures.Insert(imgPath).ShapeRange
                    .LockAspectRatio = msoFalse
                    .Height = rng.Height
                    .Width = rng.Width
                    .Left = rng.Left
                    .Top = rng.Top
                End With
                
                Set rng = Nothing
            End If
            
        End If
    Set regex = Nothing
    End Sub

    여러가지 방법으로 할 수 있겠으나

    저는 정규식으로 구현해보았습니다.

    주석은 달아놨으니 해보시고 이해 안되는 부분은 말씀해주세요.


    • 2021-10-14 12:19

      @ToString 님 먼저 답변 감사합니다!!

      해봤는데 잘 되지 않는 것 같습니다.

      그리고 호랑이,고양이 한정이 아니라 제가 다시 파일 첨부 드렸는데요. 제가 하고자하는게 설명이 부족한 것 같아 다시 자세히 설명, 조건 적었습니다.

      맨 앞 셀에 호랑이,고양이 등등 큰 구분이 들어가고(SC219Q) 그걸 비교해서 고양이면 그쪽 오른쪽에 번호에 따라 이미지 삽입이 되었으면 좋겠습니다. 실제로는(SC219Q-30-01 , SC219Q-30-05) 이런 식에 파일 명에 파일이 들어갑니다.

      조건1. 맨 앞 셀에 값과 파일명에 첫번 쨰 "-" 기준으로 앞에 글자(글자 수는 바뀔수도 있어요..)를 비교하여 일치하는지 확인

      조건2. 조건1 만족하면 이미지 넣는 셀 위에 숫자와 파일 명에 맨 뒤 숫자를 비교하여 각각에 맞는 셀에 이미지 삽입

      너무 조건이 많네요..

      첨부파일 : 이미지.xlsm


      • 2021-10-14 14:29

        @tu1541

        Private Function GetPathExtension(FilePath As String) As String
            GetPathExtension = Right(FilePath, Len(FilePath) - InStrRev(FilePath, "\"))
        End Function
        
        Sub AutoInsertPic()
            Dim imgPath As String
            imgPath = Application.GetOpenFilename("Picture, *.jpg;*.bmp;*.tif;*.gif;*.png")
            If imgPath = "False" Then: Exit Sub
        
            Dim FileName As String, Items() As String, No As Integer, rng As Range
            FileName = Split(GetPathExtension(imgPath), ".")(0)
            
            Items = Split(FileName, "-")
            No = Items(UBound(Items))
            
            Set rng = Cells.Find(CStr(Items(0)))
            If Not rng Is Nothing Then
                Set rng = Range(rng.Address & ":X" & rng.Row + 9).Find(No)
                If Not rng Is Nothing Then
                    ' # 이미지 삽입
                    Set rng = Cells(rng.Row + 1, rng.Column)
                    With ActiveSheet.Pictures.Insert(imgPath).ShapeRange
                        .LockAspectRatio = msoFalse
                        .Height = rng.Height
                        .Width = rng.Width
                        .Left = rng.Left
                        .Top = rng.Top
                    End With
                End If
            End If
        End Sub

         

        첨부파일 및 소스코드 참고하세요.
        다음에는 예시 설명을 정확하게 부탁드립니다.

        첨부파일 : 이미지-3.xlsm


        • 2021-10-14 17:29

          @ToString 님 설명을 자세히 안 적었었네요...죄송합니다.

          소스코드 잘 작동 하는 거 같습니다. 감사합니다!!

          다중 파일 선택이 가능하게 구현은 안될까요? 단일 파일 선택으로는 파일이 많아 어려워 보여서요..


          • 2021-10-15 08:30
            채택된 답변

            @tu1541

            Private Function GetPathExtension(FilePath As String) As String
                GetPathExtension = Right(FilePath, Len(FilePath) - InStrRev(FilePath, "\"))
            End Function
            
            Sub AutoInsertPic()
                Dim selectedFile As Variant
                selectedFile = Application.GetOpenFilename("Picture, *.jpg;*.bmp;*.tif;*.gif;*.png", MultiSelect:=True)
                If Not IsArray(selectedFile) Then: Exit Sub
            
                For Each imgPath In selectedFile
                    Dim FileName As String, Items() As String, No As Integer, rng As Range
                    FileName = Split(GetPathExtension(CStr(imgPath)), ".")(0)
                    
                    Items = Split(FileName, "-")
                    No = Items(UBound(Items))
                    
                    Set rng = Cells.Find(CStr(Items(0)))
                    If Not rng Is Nothing Then
                        Set rng = Range(rng.Address & ":X" & rng.Row + 9).Find(No)
                        If Not rng Is Nothing Then
                            ' # 이미지 삽입
                            Set rng = Cells(rng.Row + 1, rng.Column)
                            With ActiveSheet.Pictures.Insert(CStr(imgPath)).ShapeRange
                                .LockAspectRatio = msoFalse
                                .Height = rng.Height
                                .Width = rng.Width
                                .Left = rng.Left
                                .Top = rng.Top
                            End With
                        End If
                    End If
                Next
            End Sub

             

            안녕하세요. Multiselect 가능하게 변경한 소스입니다.

            테스트를 해보지 않았는데... 한번 저걸로 테스트 해보세요.


            • 2021-10-15 09:43

              @ToString 님 와...너무 간단하게 다중 파일 선택도 되네요...

              감사합니다!!


전체 7,759
번호 카테고리 제목 작성자 작성일 추천 조회
알림
🎉다양한 이벤트와 함께 진행하는, PPT 보고서 디자인 특강 안내 - 9/24 (토) 오후 9시~ (15)
오빠두엑셀 | 2022.09.08 | 추천 9 | 조회 2292
오빠두엑셀 2022.09.08 9 2292
공지사항 함수/공식
[신규 기능 업데이트!] 👉 이제 게시글 작성시 스크린샷 복/붙이 가능합니다! 😎 (3)
오빠두엑셀 | 2022.08.04 | 추천 4 | 조회 1636
오빠두엑셀 2022.08.04 4 1636
공지사항 함수/공식
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (93)
오빠두엑셀 | 2021.10.28 | 추천 123 | 조회 7371
오빠두엑셀 2021.10.28 123 7371
42449 함수/공식
New 숫자만 추출하여 연산하기 엑셀파일
eexcell | 11:00 | 추천 0 | 조회 5
eexcell 11:00 - 5
42447 함수/공식
New 여러개의 날짜로 되어 있는 것을 특정 날짜로 개수를 count 하고자 하는데, 잘 안됩니다. ㅠ.ㅠ (1)
jrki**** | 10:12 | 추천 0 | 조회 11
jrki**** 10:12 - 11
42442 함수/공식
New 이름을 검색할수 있는 함수와 부가적 기능.. 첨부파일 (1)
gogoexcel | 03:23 | 추천 0 | 조회 19
gogoexcel 03:23 - 19
42441 VBA
New 재고관리에서 비율 자동 계산 방법 첨부파일
EXCELEXCEL | 01:21 | 추천 0 | 조회 22
EXCELEXCEL 01:21 - 22
42434 VBA
New 셀레니움을 통한 엣지 호출 첨부파일 (2)
로고테라피 | 2022.09.25 | 추천 0 | 조회 23
로고테라피 2022.09.25 - 23
42432 VBA
New get_db 명령어 관련 질문드립니다 첨부파일 (3)
EXCELEXCEL | 2022.09.25 | 추천 0 | 조회 33
EXCELEXCEL 2022.09.25 - 33
42427 기능/도구
New 엑셀 '안전모드' 실행하는 방법 질문드립니다. 첨부파일 (4)
월마리아 | 2022.09.25 | 추천 0 | 조회 34
월마리아 2022.09.25 - 34
42426 VBA
New 사진대지 VBA 매크로 수정 엑셀파일 (1)
WWW | 2022.09.25 | 추천 0 | 조회 26
WWW 2022.09.25 - 26
42414 기능/도구
New 엑셀로 가능한지 여쭤봅니다. 엑셀파일첨부파일 (1)
naver_5f055a605ee7d | 2022.09.24 | 추천 0 | 조회 60
naver_5f055a605ee7d 2022.09.24 - 60
42405 함수/공식
New 엑셀 INDEX MATCH 함수 질문드립니다. (다중조건) 첨부파일 (3)
임천명 | 2022.09.24 | 추천 0 | 조회 44
임천명 2022.09.24 - 44
42396 함수/공식
New 함수조언 엑셀파일 (1) 답변완료
엑셀공부중 | 2022.09.24 | 추천 0 | 조회 39
엑셀공부중 2022.09.24 - 39
42395 함수/공식
New 함수 결과값 자동 갱신 질문입니다 엑셀파일 (2)
lifeti**** | 2022.09.24 | 추천 0 | 조회 36
lifeti**** 2022.09.24 - 36
42391 VBA
New 검색어와 동일한 결과값에 하이라이트 색깔 넣기 첨부파일 (2) 답변완료
조지아 칸타타 | 2022.09.23 | 추천 0 | 조회 44
조지아 칸타타 2022.09.23 - 44
42390 VBA
New 검색어 입력시 같은 정보가 2개 반복되어... 첨부파일
조지아 칸타타 | 2022.09.23 | 추천 0 | 조회 29
조지아 칸타타 2022.09.23 - 29
42386 함수/공식
New 조건부서식 오류 엑셀파일첨부파일 (3)
Ngw77 | 2022.09.23 | 추천 0 | 조회 36
Ngw77 2022.09.23 - 36
42385 기능/도구
New 파일 가로로 통합하기(합치기) 질문입니다 첨부파일 (1)
감귤쫀드기 | 2022.09.23 | 추천 0 | 조회 36
감귤쫀드기 2022.09.23 - 36
42379 문서서식
New 가로로 작업했는데, 내용 보존?하면서 세로로 쉽게 바꿀 수 있는 방법이 있나요?? (1)
앨리 | 2022.09.23 | 추천 0 | 조회 50
앨리 2022.09.23 - 50
42378 차트/그래프
New 강우-유출량 그래프 분석 엑셀파일 (1)
chanyk | 2022.09.23 | 추천 0 | 조회 47
chanyk 2022.09.23 - 47
42377 함수/공식
New 한도액에서의 지원금 정산하기 엑셀파일 (2)
송인숙 | 2022.09.23 | 추천 0 | 조회 32
송인숙 2022.09.23 - 32
42374 함수/공식
New 각기 다른셀에 값 입력시 한셀에 날짜 자동 나타내기 (2)
MC쿠마 | 2022.09.23 | 추천 0 | 조회 27
MC쿠마 2022.09.23 - 27
42372 함수/공식
New 조건별 날짜계산 함수 계산 엑셀파일 (2) 답변완료
Ngw77 | 2022.09.23 | 추천 0 | 조회 43
Ngw77 2022.09.23 - 43
42367 기능/도구
New 엑셀2019에서 shift + 스크롤 (시트 좌우 스크롤) 되는건가요? 첨부파일 (4) 답변완료
월마리아 | 2022.09.22 | 추천 0 | 조회 44
월마리아 2022.09.22 - 44
42366 구글시트
New 스프레드 시트 필터함수 엑셀파일첨부파일 (5) 답변완료
거꾸로문 | 2022.09.22 | 추천 0 | 조회 49
거꾸로문 2022.09.22 - 49
42362 함수/공식
New NaverFinanceHistory 함수 연결 데이터 갱신 질문입니다 엑셀파일첨부파일
lifeti**** | 2022.09.22 | 추천 0 | 조회 34
lifeti**** 2022.09.22 - 34
42358 VBA
New VBA 텍스트 파일 저장 후 불러오기 질문드립니다. 엑셀파일
LovelyK | 2022.09.22 | 추천 0 | 조회 42
LovelyK 2022.09.22 - 42
42355 함수/공식
New 근속년수 산출 관련 문의 (4)
꼬맹이영 | 2022.09.22 | 추천 0 | 조회 63
꼬맹이영 2022.09.22 - 63
42354 함수/공식
New 세가지의 조건을 만족하는 값 불러오기 엑셀파일 (3) 답변완료
뎡이 | 2022.09.22 | 추천 0 | 조회 71
뎡이 2022.09.22 - 71
42348 차트/그래프
New 엑셀 일일 데이터관리 차트를 만들려고 합니다,,, 첨부파일 (2)
MC쿠마 | 2022.09.22 | 추천 0 | 조회 58
MC쿠마 2022.09.22 - 58
42342 기능/도구
New 엑셀 셀의 열너비, 행높이 고정 문의드립니다. (4)
함수시르미 | 2022.09.22 | 추천 0 | 조회 54
함수시르미 2022.09.22 - 54
42341 함수/공식
New  증가 또는 하락하는 함수 문의 합니다. 엑셀파일 (1) 답변완료
천형기 | 2022.09.22 | 추천 0 | 조회 45
천형기 2022.09.22 - 45