엑셀 사진 넣기 매크로 삽입 vba / 사진대지

 

 

 

이번에는  엑셀 사진넣기 매크로 VBA 에 대해 자세히 알아보는 시간 가지도록 하겠습니다. 엑셀로 사진을 자동으로 넣고 싶은분들 사진대지 매크로를 만들고 싶은분들에게 유용한 정보가 될것 같습니다. 엑셀 사진대지 VBA , 사진넣기 매크로에 대해 궁금하시다면 따라오세요~

 

 

 

 

 

 

1. 사진넣기 매크로 VBA 기본 소스

 

 

사진넣기 버튼을 누르면 A2 셀부터 아래로 사진을 넣어줍니다.

셀의 폭과 높이에 딱맞게 들어갑니다.

 

사진삭제 버튼을 누르면 A2셀부터 Z999999 까지의 셀을 선택한후 그 범위안에 있는 사진만 삭제합니다.

 

 

 

 

VBA 소스는 다음과 같습니다.

Option Explicit

Public Const strCoName      As String = "사진대지"
Public Const strType        As String = "Image Files (*.bmp;*.gif;*.tif;*.jpg;*.jpeg;*.wmf;*.png)," & _
                                        "*.bmp;*.gif;*.tif;*.jpg;*.jpeg;*.wmf;*.png"
Dim i                     As Long
Dim lngLastRow              As Long
Sub cabPicture()
    Dim vFiles              As Variant
    Dim vFile               As Variant
    Dim sha                 As Shape
    Dim rngPic              As Range
    Dim Pw, Ph

    Application.ScreenUpdating = False        
    vFiles = Application.GetOpenFilename(fileFilter:=strType, Title:=strCoName, MultiSelect:=True)
     
If TypeName(vFiles) = "Boolean" Then
        MsgBox "선택한 이미지파일이 없습니다."         
    Else   
         i = 2
        For Each vFile In vFiles
            Set rngPic = Sheet1.Cells(i, 1).MergeArea
            With rngPic
                Set sha = Sheet1.Shapes.AddPicture(Filename:=CStr(vFile), _
                                                      LinkToFile:=msoTrue, _
                                                      SaveWithDocument:=msoTrue, _
                                                      Left:=.Left, _
                                                      Top:=.Top, _
                                                      Width:=-1, _
                                                      Height:=-1)
                          sha.LockAspectRatio = msoFalse
            End With           
        i = i + 1                        
        Next vFile         
    Set sha = Nothing     
    Application.ScreenUpdating = True         
    MsgBox "작업이 완료되었습니다."         
    End If

 

 

 

2. 원본사진 사이즈 그대로 불러오기

 

 

위 코드에서 만약 사진을 셀이 맞추지 않고 원본사진 사이즈 그대로 불러오고 싶다면 위소스에서

 

With rngPic
                Set sha = Sheet1.Shapes.AddPicture(Filename:=CStr(vFile), _
                                                      LinkToFile:=msoTrue, _
                                                      SaveWithDocument:=msoTrue, _
                                                      Left:=.Left, _
                                                      Top:=.Top, _
                                                      Width:=-1, _
                                                      Height:=-1) 
                          sha.LockAspectRatio = msoFalse
            End With

 

빨간색부분만 수정하시면 됩니다.

 

 

 

 

3. 여백있게 사진불러오기

 

사진이 셀이 맞게 삽입되면 여백이 없어서 보기가 좀 안좋을때가 있습니다. 약간의 여백이 있으면 깔끔하니 보기가 한결 나아집니다.

 

 

위 이미지 처럼 말이죠~

 

소스를 아래 빨간색 부분만 고치면 됩니다.

 With rngPic
                Set sha = Sheet1.Shapes.AddPicture(Filename:=CStr(vFile), _
                                                      LinkToFile:=msoTrue, _
                                                      SaveWithDocument:=msoTrue, _
                                                      Left:=.Left + 2, _
                                                      Top:=.Top + 2, _
                                                      Width:=.Width - 4, _
                                                      Height:=.Height - 4)
          
          
          
                          sha.LockAspectRatio = msoFalse
            End With

 

 

 

 

 

4. 가로로는 4칸식 세로로는 한칸 뛰우고 이미지 삽입하기

 

 

위 이미지 처럼 가로로는 네개씩 세로로는 한칸 뛰우고 그림을 삽입하는 소스입니다.

 

아래 빨간색부분(2개소)만  변경하시면 됩니다.

 

   i = 1
        
        For Each vFile In vFiles
        
               Set rngPic = Sheet1.Cells(((i - 1) \ 4) * 2 + 2, ((i - 1) Mod 4) + 1).MergeArea

 

가로로 4열씩 나열하는 공식은

((i - 1) Mod 4) + 1

입니다.

 

세로로 한칸 건너서 넣는 공식은

(i - 1) \ 4) * 2 + 2

입니다.

 

위 공식을 잘 이해하기 위해서는 나머지(mod) 와 몫(\) 의 개념을 공부하고 오시면 되겠습니다.

 

예제를 통해 조금더 응용해보겠습니다.

 

만약 가로로 6칸  세로로는 3칸 건너서 넣고싶다면

Set rngPic = Sheet1.Cells(((i - 1) \ 6) * 3 + 2, ((i - 1) Mod 6) + 1).MergeArea

 

만약 가로로 3칸 세로로는 뛰우지말고 연속헤서 넣고싶다면

Set rngPic = Sheet1.Cells(((i - 1) \ 3) * 1 + 2, ((i - 1) Mod 3) + 1).MergeArea

 

입니다.

 

 

 

5. 지정한 범위의 사진만 삭제하는 VBA

 

지정한 범위의 사진만 삭제하는 VBA 소스입니다.

Sub DeletePic()
    Dim xPicRg As Range
    Dim xPic As Picture
    Dim xRg As Range
    Application.ScreenUpdating = False
    Set xRg = Range("A2:A999999")
    For Each xPic In ActiveSheet.Pictures
        Set xPicRg = Range(xPic.TopLeftCell.Address & ":" & xPic.BottomRightCell.Address)
        If Not Intersect(xRg, xPicRg) Is Nothing Then xPic.Delete
    Next
    Application.ScreenUpdating = True
End Sub

 

위의 빨간색 부분을 원하는 범위로 수정하시면 되겠습니다.

 

 

 

이렇게 해서 사진삽입 매크로 VBA 에 대해 알아보았습니다. 이정도만 알아도 편하게 사진을 삽입하는 매크로를 짤수가 있을겁니다.  사진대지 VBA에 대해 궁금하셨던분들에게는 아주 유용한 정보가 될듯합니다. 다음에는 더욱 유용한 정보로 찾아올것을 약속드리며 이번 포스팅은 여기까지 하도록 하겠습니다. 오늘 하루도 행복한 하루 되세요~

 

사진삽입_vba.xlsm

0.26MB

 

 

샘플파일도 첨부합니다. 필요하신분은 다운로드해서 사용하세요~

 

 

#사진넣기 #사진대지 #사진첨부 #사진삽입 #엑셀 #매크로 #VBA

 

 

♥공감은 고래도 춤추게 합니다~ ^^