엑셀 VBA 선택영역을 이미지로 추출 :: 이미지 저장 매크로

선택한 영역을 이미지로 추출하는 이미지 추출 매크로 마스터 코드의 동작원리와 실전 응용예제를 단계별로 살펴봅니다.

홈페이지 » 엑셀 VBA 선택영역을 이미지로 추출 :: 이미지 저장 매크로

강의소개

이번 강의에서는 엑셀 선택영역 또는 선택한 시트를 이미지로 저장하기 위한 'VBA 이미지 저장 매크로'를 작성합니다. 선택영역 또는 시트에서 사용된 영역을 자동으로 인지하여 그림파일로 저장할수도 있습니다.

패치노트

Q. 선택영역이 아닌 시트 전체를 그림파일로 저장하고 싶어요

Rng_To_Image 함수를 아래와 같이 입력하면 해당 워크시트의 사용된 범위를 자동으로 인지하여 시트에서 사용된 범위 전체를 그림으로 출력합니다.

Rng_To_Image Activesheet.UsedRange

Q.  저장경로를 통합문서와 같은 경로로 설정하고 싶어요.

4-b 오류처리 부분에서, 저장경로를 아래와 같이 변경합니다.

If ValidFileName(FileName) = False Then MsgBox "올바른 파일명을 사용하세요.": End
 
If SavePath = "" Then SavePath = ActiveWorkBook.Path & "\"   '// 이 부분에서 SavePath를 통합문서의 저장경로로 변경합니다.
FilePath = SavePath & FileName & ".png"
 
If AddSequence = True Then
    FilePath = FileSequence(FilePath, 1)
End If

예제파일 및 E-Book 교재 다운로드

영상강의

관련 기초함수
지정한 경로에 파일존재여부를 확인합니다.
컴퓨터의 바탕화면 경로를 출력합니다.

1. 예제파일 이해하기 (직원 급여명세서 기본양식)

예제파일은 3개의 시트를 포함합니다.

  • 세율표 : [2019년 기준] 소득세 및 4대보험의 요율이 작성된 시트입니다.
  • 급여자료 : 세율표를 기준으로 각 직원별 월소득에 따른 공제액과 실수령액을 계산합니다.
  • 급여명세서 : 월과 사원번호를 선택하여 직원의 급여명세서를 출력합니다. 자료는 급여자료시트를 기준으로 출력합니다.

급여자료 및 급여명세서에는 INDEX/MATCH 함수가 사용되었습니다. 함수에 대한 자세한 설명은 관련포스트를 참고하세요.

INDEX MATCH 함수 다중조건
[급여명세서] 시트의 각 직원별 지급액/공제액은 INDEX/MATCH 다중조건 함수를 사용하여 참조합니다.

2. 강의에 사용된 전체 명령문

Option Explicit
 
Sub Test()
 
Rng_To_Image Selection
 
End Sub
 
Function ValidFileName(ByVal FileName As String) As Boolean
 
Dim Arr As Variant: Dim Val As Variant
Dim Pnt As Long
 
Arr = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
 
If InStr(1, FileName, ":\") > 0 Then
    Pnt = InStrRev(FileName, "\")
    FileName = Right(FileName, Len(FileName) - Pnt)
    Debug.Print FileName
End If
 
ValidFileName = True
 
For Each Val In Arr
    If InStr(1, FileName, Val) > 0 Then ValidFileName = False: Exit Function
Next
 
End Function
 
Sub Rng_To_Image(rngSelection As Range, _
                Optional FileName As String = "엑셀이미지", _
                Optional SavePath As String = "", _
                Optional AddSequence As Boolean = True)
 
 
Dim NewWs As Worksheet
Dim picRange As Object: Dim MyObj As Chart
Dim PicH As Double: Dim PicW As Double
Dim FilePath As String
 
If ValidFileName(FileName) = False Then MsgBox "올바른 파일명을 사용하세요.": End
 
If SavePath = "" Then SavePath = GetDesktopPath
FilePath = SavePath & FileName & ".png"
 
rngSelection.CopyPicture xlScreen, xlPicture
 
Set NewWs = ActiveWorkbook.Sheets.Add
NewWs.Paste
 
Set picRange = NewWs.Shapes.Item(1)
With picRange
    PicH = .Height
    PicW = .Width
    .Delete
End With
 
With NewWs.Shapes.AddChart2
    .Height = PicH
    .Width = PicW
End With
 
Set MyObj = NewWs.Shapes.Item(1).Chart
 
MyObj.ChartArea.Select
MyObj.Paste
 
If AddSequence = True Then
    FilePath = FileSequence(FilePath, 1)
End If
 
MyObj.Export FilePath, "PNG"
 
Application.DisplayAlerts = False
NewWs.Delete
Application.DisplayAlerts = True
 
End Sub
 
Public Function FileExists(ByVal path_ As String) As Boolean
 
    FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function
 
Public Function GetDesktopPath(Optional BackSlash As Boolean = True) As String
 
Dim oWSHShell As Object
 
Set oWSHShell = CreateObject("WScript.Shell")
 
If BackSlash = True Then
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop") & "\"
Else
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop")
End If
 
Set oWSHShell = Nothing
 
End Function
 
Function FileSequence(FilePath As String, Optional Sequence As Long = 1) As String
 
Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long
 
Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)
 
newPath = Path & Sequence & Ext
 
Do Until FileExists(newPath) = False
    Sequence = Sequence + 1
    newPath = Path & Sequence & Ext
Loop
 
FileSequence = newPath
 
End Function

3. 강의에 사용된 VBA 사용자 지정함수

본 강의에서는 총 4개의 추가 사용자지정함수를 사용하였습니다.

  • FileExists 함수 : 파일경로의 기존 파일존재여부를 확인합니다.
  • GetDesktopPath 함수 : 컴퓨터의 바탕화면 경로를 출력합니다.
  • FileSequence 함수 : 파일이름이 중복되지 않도록 순번을 매깁니다.
  • ValidFileName 함수 : 지정한 파일이름의 사용가능여부를 확인합니다.
FileExists 함수 (VBA) :: 사용자지정함수 [상세설명 및 예제 보러가기]
설명 : 지정한 파일경로의 파일존재여부를 확인합니다. 
구문 : = FileExists ( 파일경로 )
Public Function FileExists(ByVal path_ As String) As Boolean
 
FileExists = (Dir(path_, vbDirectory) <> "")
 
End Function
 
Sub 파일존재여부확인(Path As String)
 
'##################################################################################
'Path로 입력된 경로에 파일이 존재하는지 여부를 확인하여 안내메세지를 띄웁니다.
'##################################################################################
 
If FileExists(Path) = True Then
MsgBox "해당 파일이 이미 존재합니다." & vbNewLine & _
"파일경로 : " & vbNewLine & _
Path
Else
MsgBox "해당 파일이 존재하지 않습니다."
End If
 
End Sub
GetDesktopPath 함수 (VBA) :: 사용자지정함수 [상세설명 및 예제 보러가기]
설명 : 사용자 컴퓨터의 바탕화면경로를 출력합니다. 
구문 : = GetDesktopPath ( [백슬래쉬표시] )
Public Function GetDesktopPath(Optional BackSlash As Boolean = True) As String
 
'// 사용자의 바탕화면 경로를 출력합니다.
 
Dim oWSHShell As Object
 
Set oWSHShell = CreateObject("WScript.Shell")
 
If BackSlash = True Then
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop") & "\"
Else
    GetDesktopPath = oWSHShell.SpecialFolders("Desktop")
End If
 
Set oWSHShell = Nothing
 
End Function
 
Sub 바탕화면경로_()
 
MsgBox "현재 사용중인 컴퓨터의 바탕화면 경로는" & vbNewLine & _
        "[[ " & GetDesktopPath & " ]]" & vbNewLine & _
        "입니다."
 
End Sub
FileSequence 함수 (VBA) :: 사용자지정함수 [상세설명 및 예제 보러가기]
설명 : 파일이름이 중복되지 않도록 파일이름에 순번을 매깁니다.
구문 : = FileSequence ( 파일경로, [시작번호] )
Function FileSequence(FilePath As String, Optional Sequence As Long = 1) as String
 
Dim Ext As String: Dim Path As String: Dim newPath As String
Dim Pnt As Long
 
Pnt = InStrRev(FilePath, ".")
Path = Left(FilePath, Pnt - 1)
Ext = Right(FilePath, Len(FilePath) - Pnt + 1)
 
newPath = Path & Sequence & Ext
 
Do Until FileExists(newPath) = False
    Sequence = Sequence + 1
    newPath = Path & Sequence & Ext
Loop
 
FileSequence = newPath
 
End Function
 
Sub 파일저장()
 
Dim strPath As String
Dim newPath As String
 
strPath = GetDesktopPath & "복사본.xlsm"
newPath = FileSequence(strPath, 1)
 
ThisWorkbook.SaveAs newPath
 
MsgBox newPath & "경로로 파일저장을 완료하였습니다."
 
End Sub
ValidFileName 함수 (VBA) :: 사용자지정함수 [상세설명 및 예제 보러가기]
설명 : 지정한 파일이름의 사용가능 여부를 확인합니다.
구문 : = ValidFileName ( 파일경로 )
Function ValidFileName(ByVal FileName As String) As Boolean
 
Dim Arr As Variant: Dim Val As Variant
Dim Pnt As Long
 
Arr = Array("/", "\", ":", "*", "?", """", "<", ">", "|")
 
If InStr(1, FileName, ":\") > 0 Then
    Pnt = InStrRev(FileName, "\")
    FileName = Right(FileName, Len(FileName) - Pnt)
    Debug.Print FileName
End If
 
ValidFileName = True
 
For Each Val In Arr
    If InStr(1, FileName, Val) > 0 Then ValidFileName = False: Exit Function
Next
 
End Function
 
Sub 파일이름체크()
 
If ValidFileName(Sheet1.Range("F2").Value) = True Then
    MsgBox "사용가능한 파일이름입니다."
Else
    MsgBox "사용 불가한 파일이름입니다.", vbCritical
End If
 
End Sub

4. 매크로 동작원리 이해하기

선택한 범위를 이미지로 저장하는 매크로는 총 9단계로 작성합니다.
엑셀은 이미지를 바로 출력/저장하는 기능을 지원하지 않습니다. 따라서 이미지를 빈 차트안에 붙여넣기 한 뒤, 차트를 그림형태로 출력하는 방법을 사용합니다. (매크로의 동작원리는 영상강의에서 자세히 설명드렸습니다.)

  1. 선택된 범위를 그림형태로 복사
  2. 임시 워크시트 추가
  3. 추가된 임시시트에 이미지 붙여넣기
  4. 이미지의 높이와 넓이 확인후 이미지 제거
  5. 추가된 임시시트에 빈 차트 생성
  6. 차트의 높이와 넓이를 이미지와 동일하게 변경
  7. 차트안에 이미지 붙여넣기
  8. 차트를 원하는 파일경로에 이미지형태로 출력
  9. 임시 워크시트 삭제
VBA 명령문 작성하기

범위를 이미지로 저장하는 매크로 명령문을 작성합니다. 명령문 각 단계별로 알아보겠습니다.

우선 Rng_To_Image 라는 명령문을 아래와 같이 인수를 포함하여 작성합니다.

Sub Rng_To_Image(rngSelection As Range, _
                Optional FileName As String = "엑셀이미지", _
                Optional SavePath As String = "", _
                Optional AddSequence As Boolean = True)
 
 
End Sub

명령문에 추가된 인수들은 아래와 같습니다.

  • rngSelection : 사용자가 선택한 범위입니다.
  • FileName : 이미지로 저장될 파일명입니다. (기본값: 엑셀이미지)
  • SavePath : 이미지를 저장할 파일경로입니다. (기본값: 빈칸)
  • AddSequence : 이미지를 덮어쓰기 할지 또는 순번에 따라 저장할지 결정합니다.
4-A. 변수생성

아래와 같이 변수를 생성합니다.

Dim NewWs As Worksheet
Dim picRange As Object: Dim MyObj As Chart
Dim PicH As Double: Dim PicW As Double
Dim FilePath As String
  • NewWs : 임시로 추가할 워크시트입니다.
  • PicRange : 선택한 범위를 그림형태로 붙여넣기 한 이미지 개체입니다.
  • MyObj : 이미지를 붙여넣기 할 차트 개체입니다.
  • PicH, PicW : 이미지의 높이와 넓이입니다.
  • FilePath : 이미지가 저장될 파일명을 포함한 전체 파일경로입니다.
4-B. 파일이름 점검 및 저장할 파일경로 생성

윈도우에는 파일이름으로 사용불가한 특수기호가 있습니다. 사용자가 지정한 파일이름이 윈도우에서 사용가능한지 파일이름을 점검합니다.

파일이름에 이상이 없을 시, 전체 파일경로를 생성합니다. 명령문의 보조 인수 중 SavePath 가 빈칸일 경우, GetDesktopPath 함수를 통해 바탕화면에 파일이 저장되도록 만들어줍니다.

AddSequence 인수가 True일경우, 파일 이름을 순번에 따라 저장합니다. 이전 단계에서 붙여넣기 한 FileSequence 함수를 통해 파일이름에 순번을 매겨줍니다.

If ValidFileName(FileName) = False Then MsgBox "올바른 파일명을 사용하세요.": End
 
If SavePath = "" Then SavePath = GetDesktopPath
FilePath = SavePath & FileName & ".png"
 
If AddSequence = True Then
    FilePath = FileSequence(FilePath, 1)
End If
4-C. 선택한 범위를 그림형태로 복사

선택된 범위를 그림형태로 복사합니다. 본 예제에서는 사용자가 선택한 범위를 rngSelection으로 받아왔지만, 별도의 범위를 임의로 설정할 수도 있습니다.

rngSelection.CopyPicture xlScreen, xlPicture
4-D. 임시시트 생성 및 그림 붙여넣기

그림을 붙여넣기 할 임시시트를 생성한 뒤, 시트에 이미지를 붙여넣기 합니다.

Set NewWs = ActiveWorkbook.Sheets.Add
NewWs.Paste
4-E. 이미지의 높이와 넓이 확인 후 이미지 제거

붙여넣기 한 이미지의 높이와 넓이를 확인한 뒤, 이미지를 삭제합니다.

Set picRange = NewWs.Shapes.Item(1)
With picRange
    PicH = .Height
    PicW = .Width
    .Delete
End With
4-F. 빈 차트 생성 및 높이와 넓이 조정

임시 시트에 빈 차트를 생성한 뒤, 차트의 높이와 넓이를 이미지와 동일하게 조정합니다.

With NewWs.Shapes.AddChart2
    .Height = PicH
    .Width = PicW
End With
4-G. 빈 차트안에 그림 붙여넣기

차트 안에 그림을 붙여넣기 합니다. 차트안에 그림을 붙여넣기 할 때에는 반드시 Select를 통해 차트가 선택이 된 상태에서 Paste로 붙여넣기 해야만 매크로가 동작한다는 점을 주의하세요.

Set MyObj = NewWs.Shapes.Item(1).Chart
 
MyObj.ChartArea.Select
MyObj.Paste
4-H. 차트를 이미지로 저장

차트를 이미지로 저장합니다. 이전 단계에서 만들어준 파일 경로에 PNG 형태의 이미지로 저장합니다.

MyObj.Export FilePath, "PNG"
4-I. 임시시트 삭제

매크로 실행을 위해 추가했던 임시 워크시트를 삭제합니다.

엑셀은 기본적으로 시트를 삭제할 시 안내메세지를 출력합니다. 안내메세지 출력을 방지하기 위해 시트 삭제 전 DisplayAlerts 속성을 False로 변경합니다.

Application.DisplayAlerts = False
NewWs.Delete
Application.DisplayAlerts = True

5. 이미지 저장 매크로 테스트

작성한 명령문이 잘 동작하는지 테스트합니다. 아래와 같이 Test 명령문을 작성한 뒤 실행합니다.

Sub Test()
 
Rng_To_Image Selection
 
End Sub

매크로를 실행하면 아래와 같이 바탕화면에 선택된 범위가 이미지로 저장되는 것을 확인할 수 있습니다.

범위를 이미지로 저장 매크로 완성 GIF
시트에 도형을 추가한 뒤, Test 매크로를 지정하여 매크로가 잘 동작하는지 테스트합니다.
5 8 투표
게시글평점
guest
28 댓글
Inline Feedbacks
모든 댓글 보기
hjkang
hjkang
2019년 12월 24