반응형

엑셀작업을 하다보면 VBA 메크로로 셀에 자동맞춤으로 이미지를 삽입되게 하면 이미지작업이 많을시 무척 편리하게 이용할 수 있습니다.


[VBA메크로 만드는 방법]

열려진 엑셀문서에서 Alt+F11(단축키)를 실행하면 VBA창이 열립니다.

삽입 - 모듈을 선택하면 아래 이미지와 같은 창이 열립니다.


[삽입코드 - 이미지셀폭에 자동으로 맞춤, 이미지 엑셀문서에 포함되어지는 코드]

Sub insert_Pic()
    Dim Pic   As Variant
    Pic = Application.GetOpenFilename _
                    (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif;*.png;*.jpeg")
    If Pic = False Then
        Exit Sub
    End If
    With ActiveSheet.Shapes.AddPicture(Pic, False, True, Selection.Left, Selection.Top, Selection.Width, Selection.Height)
        .LockAspectRatio = msoFalse
    End With
End Sub

위의 코드를 삽입하고 VBA창을 닫습니다.


[엑셀문서에 만들어진 메크로 적용하기]

1. 이미지가 삽입될 셀을 만듭니다.

2. 삽입 - 도형 에서 알맞은 도형을 선택해서 화면위에 넣습니다.

(도형이 아니어도 상관 없으며 위치도 어디던지 상관 없습니다)

3. 도형위에 우측마우스 - 메크로지정 선택

 


4. 메크로지정후 확인

 


5. 이미지를 삽입할 셀을 마우스로 선택후 메크로가 지정된 버턴을 클릭하면 파일탐색기가 나옵니다. 

이미지를 선택하여 넣으시면 됩니다.


6. 만들어진 엑셀파일을 메크로 파일이 작동되게끔 저장할려면 

다른이름으로 저장 - 파일형식을 "Excel 매크로 사용 통합 문서(*.xlsm)"으로 저장하시면 됩니다.


[주의 사항]

엑셀로 그림포함 작업시 그림삽입으로 문서를 작성한 경우 기본설정으로 저장시 그림이 문서안에 저장됩니다.

그런데 위의 설명에서 처럼 메크로 작업으로 이미지삽입된 엑셀파일을 만들경우 보통의 코드로 작업시 

이미지파일의 경로가 변경되거나 삭제,이름바꾸기 같은 작업이 이루어지면 엑셀문서안의 이미지파일은 엑박으로 뜹니다. 이런 경우 이미지없이 엑셀파일만 메일로 보내거나 USB(CD)에 담아 가면 이미지들이 출력이 되지를 앟습니다.

그래서 제가 드린 코드로 메크로파일을 작성하시면 경로와 상관없이 엑셀파일안에 이미지가 포함되어져 문서가 작성됩니다.

[일반적인 이미지 삽입 메크로코드]

Sub insert_Pic()

    Dim Pic   As Variant

    Pic = Application.GetOpenFilename _

                    (filefilter:="Picture Files,*.jpg;*.bmp;*.tif;*.gif;*.png")

    If Pic = False Then

        Exit Sub

    End If

     With ActiveSheet.Pictures.Insert(Pic).ShapeRange

        .LockAspectRatio = msoFalse

        .Height = Selection.Height

        .Width = Selection.Width

        .Left = Selection.Left

        .Top = Selection.Top

    End With

End Sub 

"Pictures.Insert" 는 링크로 참조하여 삽입할때 사용됩니다.

메일로 보내면 당연히 상대방 컴퓨터에서는 해당 파일을 찾지 못해서 안보이게 됩니다.

"Shapes.AddPicture" 를 사용 하시고 3번째 인수값이 true 일경우 사진과 함께 파일을 저장하는 인수값입니다.


p.s 이것은 저의 경험에서 나온 팁입니다.

그림을 문서에 포함시키지 않고 경로만 지정되게 해서 엑셀문서를 작성한경우 

엑셀문서안에 이미지를 포함 저장하는 코드입니다.

Sub embed_Pics_Permanently1()

   

    Dim shtNo As Integer                                     

    Dim i As Integer                                           

    Dim wks As Worksheet                                  

    Dim shpC As Shape                                      

    Dim picLeft As Single                                    

    Dim picTop As Single                                   

    

    Application.ScreenUpdating = False                

    

    shtNo = ActiveSheet.Index                             

    For i = 1 To Sheets.Count                              

        Sheets(i).Activate                                     

        

        For Each shpC In Sheets(i).Shapes           

            If shpC.Type = 11 Then                          

                

                picLeft = shpC.Left                            

                picTop = shpC.Top                           

                    

                shpC.Copy                                       

                ActiveSheet.PasteSpecial Link:=False 

                shpC.Delete                                     

                    

                Selection.Left = picLeft

                Selection.Top = picTop

            End If

        Next shpC

    Next i

   

    MsgBox "매크로가 종료되었습니다."

    

   Sheets(shtNo).Activate

End Sub


혹은 수정작업이 필요없거나 관람용으로만 사용할려면 "다름이름으로저장"에서 "PDF"로 저장해서 문서를 만들면 됩니다.

반응형
AND