나눔터  
  HOME > 나눔터 > 묻고답하기 > 엑셀
엑셀
엑셀에 대한 질문과 답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
 "000 님, 도와주세요", "부탁 드립니다.", "급합니다!" 등과 같이 막연한 제목을 달지 말아주세요.
[필독] 빠르고 정확한 답변을 얻는 16가지 Tip !
[필독] 저작권법 개정에 따른 이용안내
작성자:  

 랄랄루라룰라 (klesha23)

추천:  2
파일:     조회:  1734
제목:   vba 매크로 (이미지 삽입) 오류
     
  * 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.

 - 엑셀 버전(95,97,2000,xp,2003,2007): 2013

* 아래줄에 질문을 작성하세요 >>

안녕하세요! vba 초보이지만 업무에 필요해서 이것저것 검색해보며 매크로를 작성 중에 있습니다. 참고해서 어느 정도 틀이 잡힌 것 같은데 원하는 결과가 안나와서 질문드립니다ㅜㅜ

원하는 결과: 셀 값과 동일 이름을 가진 jpg 이미지가 셀 안에 3의 여유공간을 가지고 삽입되는 것 (링크 말고 엑셀이 이미지 내에 포함되었으면 좋겠어요! 그래서 addpicture을 썼습니다.)
예를 들어 컴퓨터 라고 입력되어 있는 셀에, 선택한 파일 내에 있는 컴퓨터.jpg 이미지가 이미지 비율 유지된 채로 3의 여유공간을 가지고 삽입되는 것

현재 상태: A1셀에 모든 이미지가 삽입됩니다.  addpicture 후 이름에 맞게 각 이미지가 제자리를 찾아갈 수 있도록 함수를 설정해놓았다고 생각했는데 무엇이 잘못된 걸까요? 도움 주시면 감사합니다!

현재 매크로는 다음과 같습니다.

--------------------------------------------------------------------------

Sub 이미지삽입0325()

    Dim swidth As Single 'cell
    Dim sheight As Single 'cell
    mgn = 3 'margin

'path
 With Application.FileDialog(msoFileDialogFolderPicker)
        .Show

        If .SelectedItems.Count = 0 Then
            Exit Sub
        Else
            strPath = .SelectedItems(1) & "\"
        End If
    End With
    
 Application.ScreenUpdating = False
 On Error Resume Next
 
Set Rng = Range("A1:Z2000")
For Each pic In Rng
    If Len(pic.Value) Then
        picname = pic.Value & ".jpg"
        Set tpic = ActiveSheet.Pictures.Insert(strPath & picname).ShapeRange 'insert

            tpic.LockAspectRatio = msoTrue
            tpic.Top = 1
            tpic.Left = 1
            tpic.Width = 120
            pht = tpic.Height
            
            tpic.Delete
            
            'real insert (addpicture)
            Set rpic = ActiveSheet.Shapes.addpicture(strPath & picname, msoFalse, msoTrue, 1, 1, 120, pht)
            
            'change location (mergecell)
            If Rng.Offset(0, 0).MergeCells Then
            
                swidth = Rng.Offset(0, 0).MergeArea.Width
                sheight = Rng.Offset(0, 0).MergeArea.Height
    
                rpic.Height = sheight
    
                If rpic.Width > swidth Then
                rpic.Width = swidth
                End If
                
                rpic.Height = rpic.Height - (mgn * 2)
                rpic.Top = Rng.Offset(0, 0).MergeArea.Top + (sheight - rpic.Height) / 2
                rpic.Left = Rng.Offset(0, 0).MergeArea.Left + (swidth - rpic.Width) / 2

            End If
        
      Else
    End If

Next pic
    
    Application.ScreenUpdating = True
    
End Sub

 
[불량 게시물 신고]  
        
  

작성일 : 2022-03-25(10:53)
최종수정일 : 2022-03-25(10:53)
 


 ◎ 관련글

  제 목   작성자   날짜
vba 매크로 (이미지 삽입) 오류 랄랄루라룰라 2022-03-25
[RE]vba?매크로?(이미지?삽입)?오류 잡초 2022-03-27