안녕하세요. 까칩니다.
업무를 하다보면 사진을 넣넣고 제목을 입력해야 하는데, 참 귀찮은 일이 아닐 수 없습니다.
그래서 오늘은 엑셀에 이미지를 넣는 엑셀 VBA를 만들어 보겠습니다.
저도 아는 것은 없지만, 구글을 뒤지고 뒤져서 만들어 보았습니다.
구글검색을 통해 끌어모아서 만든 것이기 때문에, 명령어에 대한 정확한 설명이 포함되어있지 않습니다.
좀 더 익숙해지고 배워 설명을 늘려가겠습니다.
예를 들어 이런식으로 사진 이름과 사진을 셀에 넣어야할 경우가 있습니다.
만약 사진이 많다면 일일이 넣어주기 귀찮습니다.
이것을 한번에 해결할 수 있는 VBA를 만들어 보겠습니다.
우선 엑셀을 열어보겠습니다.
VBA 창으로 들어가기 위해서는
Alt + F11 을 눌러줍니다.
이런 창이 뜨는데, 이창이 바로 VBA를 입력할 수 있는 창입니다.
VBA는 엑셀 매크로라고 불리는 기능으로 좀더 편하게 원하는 기능을 할 수 있게 해줍니다.
좌측 프로젝트 창에서, 모듈 폴더를 오른쪽 클릭 - 삽입 - 모듈 을 눌러줍니다.
우리는 이제 이 모듈에 코드를 입력할 것입니다.
이런 모듈 창이 나왔습니다.
코드를 선언해주겠습니다.
Sub Image_insert()
End Sub
Sub는 코드를 시작한다는 것을 선언하는 명령어입니다.
VBA는 명령어가 끝날 때, End 명령어라고 입력을 해주어야합니다.
Sub Image_insert()
Dim fileDlg As FileDialog
Dim Photo As Object
Dim E_Shape As Shape
Dim R_Num As Integer
Dim C_Num As Integer
Dim F_Path, F_Name, Hero_Name As String
End Sub
다음처럼 변수를 선언하겠습니다.
파일과 폴더에 대한 변수, 그리고 선택한 셀에 대한 변수입니다.
엑셀은 변수의 대소문자를 구분하지 않습니다.
하지만 변수를 선언할 때, 대문자를 하나 넣어주면 좋습니다.
그 이유는 변수를 입력하고 엔터 혹은 탭을 누르면 소문자로 입력한 변수가 자동으로 대문자가 포함된 변수로 변합니다.
변한것을 확인하면서 제대로 변수를 입력했구나를 확인할 수 있습니다.
Sub Image_insert()
Dim fileDlg As FileDialog
Dim Photo As Object
Dim E_Shape As Shape
Dim R_Num As Integer
Dim C_Num As Integer
Dim F_Path, F_Name, Hero_Name As String
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim cl As Range
Dim shpOval As Shape
End Sub
다음은 이미지 위치에 대한 변수를 지정해 주었습니다.
Sub Image_insert()
Dim fileDlg As FileDialog
Dim Photo As Object
Dim E_Shape As Shape
Dim R_Num As Integer
Dim C_Num As Integer
Dim F_Path, F_Name, Hero_Name As String
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim cl As Range
Dim shpOval As Shape
Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
FileDlg.Title = "이미지가 저장된 폴더를 선택하세요" ' 검색창 이름 설정
fileDlg.Show
F_Path = fileDlg.SelectedItems(1)
F_Name = Dir(F_Path & "\*.*")
End Sub
이제 이미지가 들어있는 폴더를 불러올 명령어를 입력해주었습니다.
여기까지 입력된 것을 실행하면
이렇게 사진이 포함된 폴더를 선택할 수 있는 창이 뜨게됩니다.
지금은 폴더를 선택해도 아무런 변화가 없습니다.
이제 사진을 셀에 넣어보겠습니다.
Sub Image_insert()
Dim fileDlg As FileDialog
Dim Photo As Object
Dim E_Shape As Shape
Dim R_Num As Integer
Dim C_Num As Integer
Dim F_Path, F_Name, Hero_Name As String
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim cl As Range
Dim shpOval As Shape
Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
F_dlg.Title = "이미지가 저장된 폴더를 선택하세요" ' 검색창 이름 설정
fileDlg.Show
F_Path = fileDlg.SelectedItems(1)
F_Name = Dir(F_Path & "\*.*")
'현재 선택된 행을 골라, 첫번째 열을 선택합니다. (첫 이미지를 삽입할 위치)
C_Num = ActiveCell.Column
R_Num = ActiveCell.Row
End Sub
이제 위치를 지정했으니, 사진을 넣고, 파일 이름까지 입력하겠습니다.
Sub Image_insert()
Dim fileDlg As FileDialog
Dim Photo As Object
Dim E_Shape As Shape
Dim R_Num As Integer
Dim C_Num As Integer
Dim F_Path, F_Name, Hero_Name As String
Dim clLeft As Double
Dim clTop As Double
Dim clWidth As Double
Dim clHeight As Double
Dim cl As Range
Dim shpOval As Shape
Set fileDlg = Application.FileDialog(msoFileDialogFolderPicker)
fileDlg.Title = "이미지가 저장된 폴더를 선택하세요" ' 검색창 이름 설정
fileDlg.Show
F_Path = fileDlg.SelectedItems(1)
F_Name = Dir(F_Path & "\*.*")
'현재 선택된 행을 골라, 첫번째 열을 선택합니다. (첫 이미지를 삽입할 위치)
C_Num = ActiveCell.Column
R_Num = ActiveCell.Row
'지정한 폴더의 파일을 모두 읽을때 까지 반복합니다.
Do While F_Name <> ""
Set cl = Range(Selection.Address)
clLeft = cl.Left
clTop = cl.Top
clHeight = cl.Height
clWidth = cl.Width
ActiveSheet.Shapes.AddShape(msoShapeRectangle, clLeft, clTop, clWidth, clHeight).Select
With Selection.ShapeRange.Fill
.Visible = msoTrue
.UserPicture F_Path & "\" & F_Name
.TextureTile = msoFalse
End With
'파일이름을 A열에 입력합니다.
Hero_Name = Left(F_Name, InStr(1, F_Name, ".") - 1)
Range("A" & R_Num).Value = Hero_Name ' 이 부분의 A를 원하는 알파벳으로 바꾸어 파일 이름을 넣을 위치를 바꿀 수 있습니다.
R_Num = R_Num + 1
Cells(R_Num, C_Num).Select
F_Name = Dir()
Loop
End Sub
자, 이제 다 되었습니다.
이제 원하는 위치의 셀을 클릭하고 해당매크로를 실행해준다면 사진이 쫙 삽입 되는 것을 확인할 수 있습니다.
다른 분들이 올려주신 이미지 삽입들도 많이 있지만, 제가 올린 VBA의 좋은점은 바로 셀의 크기를 바꾸면 바꾸는대로 사진의 크기가 달라지는 것입니다.
아까 처음 상태가 이랬다면
이렇게 D행을 늘려줄때 사진도 함께 늘어납니다. 또 셀안에 사진이 있기때문에 셀을 숨기면
함께 사라지는 것을 볼 수 있습니다.
이렇게 오늘 엑셀에 사진 일괄 삽입 VBA를 만들어보았습니다.
필요한 기능이 있다면 또 생각해서 올릴 수 있도록 하겠습니다.
댓글