○ 엑셀에서 쎌안에 사진을 삽입시 자동으로 리사이즈 해주는 매크로

○ 엑셀에서 쎌안에 사진을 삽입시 자동으로 리사이즈 해주는 매크로.

 

1. 엑셀에서 ALT + F11 누른다

 

 

 

 

 

 

 

위와 같은 창이 나오면 "삽입" -> "모듈" 누르면 흰바탕이 나오는데 그곳에

 

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

 

Sub insert_A_Picture_In_Folder()

Dim rngA As Range

Dim sRow As Variant, sColumn As Variant

Dim CColumn As Variant, CRow As Variant

Dim Sht As Worksheet, strPath As Variant

Dim douWid As Double, douHei As Double

Application.ScreenUpdating = False

ChDir ThisWorkbook.Path + "\"

'Cells(4, 1).Select  '// 사진을 넣을 셀을 선택

Set rngA = Selection    '// 사진을 넣을 셀을 변수에 할당

      Set Sht = ActiveSheet '// 현재 시트를 변수에 할당

    strPath = Application.Dialogs(xlDialogInsertPicture).Show

        If strPath = "False" Then

           MsgBox "아무 그림도 선택되지 않았습니다", vbExclamation, "heesung2003@naver.com"

           Exit Sub

        End If

On Error Resume Next

'mSheet.Shapes("Images_A").Delete   '// 기존사진 지움

'// □□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□

sRow = rngA.Row '// 현재셀의 행

sColumn = rngA.Column   '// 현재셀의 열

CColumn = rngA.Columns.Count    '// 사진을 넣을셀의 열갯수

CRow = rngA.Rows.Count  '// 사진을 넣을셀의 행갯수

        douWid = Abs(Sht.Cells(sRow, sColumn + CColumn).Left - rngA.Left) - 4 '// 사진의 가로크기 구함

        douHei = Abs(Sht.Cells(sRow + CRow, sColumn).Top - rngA.Top) - 4 '// 사진의 세로크기 구함

    With Selection    '// 사진을 셀에 넣음

'            .ShapeRange.LockAspectRatio = msoFalse            '//그림 좌우고정비율 해제

        If douWid / .Width < douHei / .Height Then

            .Width = douWid    '// 가로 넓이보다 4작게

        Else

            .Height = douHei   '// 세로 넓이보다 4작게

        End If

        If douWid - .Width < douHei - .Height Then

            .Top = rngA.Top + ((douHei - .Height) / 2) + 2 '// 사진의 세로 위치를 셀보다 2 크게

            .Left = rngA.Left + 2 '// 사진의 가로 위치를 셀보다 2크게

        Else

            .Top = rngA.Top + 2 '// 사진의 세로 위치를 셀보다 2 크게

            .Left = rngA.Left + ((douWid - .Width) / 2) + 2 '// 사진의 가로 위치를 셀보다 2크게

        End If

        .Name = "Images|" + rngA.Address(0, 0)

    End With

    rngA.Activate

Set Sht = Nothing

End Sub

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

위의 내용을 복사해서 붙여넣기하면 아래와 같이 된다

 

 

 

2. 따로 저장할필요없이 닫기 하고 나온 후 

 

보기에서 메크로 보기를 누르면 

 

  

아래와 같이 나오는데 여기서 실행 버튼을 누르면 사진을 선택 하라고 창이 뜬다

 

그 다음 사진 선택 후 확인 누르면 아래와 같이 사진이 알맞게 리사이즈 되면서 삽입됨

 

 

 

참고로 단축키를 설정할 수도 있는데

 

옵션에서  단축키를 설정하고 확인을 누르면 (임시로 컨트롤+a라고 했음)

 

 

 

위치에 넣을 셀을 지정한후, Ctrl+a 치니 바로 입력할 사진 선택창이 뜸

 

아래는 결과물~ 

 

끝~!!

 

 

 

 

어떠셨나요 ?