개발하는 디자이너의 DIY 일상

오늘 포스트에서는 지난 엑셀 자동화 툴의 뎃글로 문의 주신 헤더에 이미지를 VBA 를 이용하여 자동으로 삽입하는 내용을 소개해 드릴까 합니다.

네 당연히 가능하고 약간 시간이 걸리긴 했지만 유용할 듯 하여 VBA 로 작성하여 보았습니다.

나중에 시간내서 제가 만든 자동화 툴에도 구현 되도록 해보겠습니다.

오늘 내용은 어렵지 않은 내용이므로 차근차근 확인하시며 따라 오시면 될 것 같습니다.

먼저 다음의 객체로 VBA 에서 접근하여 설정을 진행하는 것을 기억해 두시기 바랍니다.

Worksheet.PageSetup.LeftHeaderPicture.Filename = "이미지 파일 경로"

Worksheet.PageSetup.LeftHeader = "헤더에 입력할 텍스트"

위와 같이 worksheet 내에 PageSetup 이라는 개체로 진입한 뒤 PageSetup 개체 내에 각종 헤더 위치에 따라 필요한 설정을 진행할 수 있습니다. 

Worksheet.PageSetup.붙일위치/타입

머릿말 및 꼬릿말의 위치 및 타입은 아래와 같은 대상을 정하여 설정을 진행할 수 있습니다. 

그림을 넣을 경우

글자를 넣을 경우

그 중 한군데에 그림을 적용하는 코드 샘플을 보여드리면 아래와 같습니다.

Sub headerInsertTest()

    Dim aSht As Worksheet    
    Set aSht = ActiveSheet ' 현재 활성화된 시트'
    
    With aSht.PageSetup   ' 반복되는 문장으로 코드가 길어지지 않도록 with 사용'
        With .LeftHeaderPicture
            .Filename = "D:\myTestImage_25.png" ' 이미지 경로'
            .Height = 25    ' 이미지의 크기를 입력'
            .Width = 25     ' 이미지의 크기를 입력'
            .ColorType = msoPictureAutomatic
        End With        
        .LeftHeader = "&G" ' 헤더에 그림을 표시함'
        .Zoom = 100        
    End With

End Sub

역시 동일한 방식으로 글자를 넣게 되면 약간만 수정해 주면 됩니다.

Sub headerInsertTest()

    Dim aSht As Worksheet    
    Set aSht = ActiveSheet ' 현재 활성화된 시트'
    
    With aSht.PageSetup   ' 반복되는 문장으로 코드가 길어지지 않도록 with 사용'
        .LeftHeader = "This Header is writen by VBA"                    
    End With

End Sub

위의 방식으로 하면 VBA 를 이용하여 헤더에 그림이나 글씨를 적용하는 것이 가능합니다.

폴더 내 모든 엑셀 파일에 동일한 머릿글 이미지 적용하려면?!?!

먼저 다른 포스트에서 요청 주신바와 같이 특정 폴더에 엑셀 시트가 수백개가 있다고 하셨는데요. 해당 폴더 내 모든 엑셀 파일에 동일한 헤더 이미지를 적용한다고 하면 약간 코드가 복잡해 지겠지요.

아마 아래와 같은 과정이 필요할 것 같습니다.

• 폴더를 지정하면 폴더내의 엑셀 파일의 리스트를 가져온다.
• 가져온 엑셀 파일에 대하여 하나씩 열어서 다음의 과정을 처리한다
  • 엑셀에 있는 모든 시트에 대하여 각각 작업이 진행되도록 한다.
  • 이미지의 경로를 이용하여 헤더에 그림을 삽입한다.
• 처리가 완료된 엑셀 파일은 저장한다.

어떤가요? 감이 오시나요?

제가 넣기 위하여 준비한 이미지는 아래와 같습니다.

테스트용 엑셀 파일은 아래와 같이 만들어 두었습니다. 하위 폴더가 있는 경우 하위 폴더의 엑셀 파일에도 적용이 되어야 하므로 하위 폴더도 만들어 준비를 했습니다. 

한번 작성된 코드를 보시죠.

Sub insertHeadertoAllXLSfiles()
    Dim fso As Object
    Dim fsoFolder As Object
    Dim rootPath As String
    Dim imagePath As String
    
    rootPath = "D:\test\files"
    imagePath = "D:\test\files\diy_dev_design_01.png"
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fsoFolder = fso.GetFolder(rootPath)
    
    getDataRecursive fsoFolder, imagePath
End Sub

Sub getDataRecursive(ByVal baseFolder As Object, ByVal imgName As String)
    
    Dim fso As Object
    Dim tmpSubFolders As Object
    Dim tmpFiles As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set tmpSubFolders = baseFolder.subFolders
    Set tmpFiles = baseFolder.Files
    
    For Each c In tmpFiles
        '여기서 각 엑셀에 실행해야 할 코드를 수행함'

        If LCase(Right(c.Name, 3)) = "xls" Or LCase(Right(c.Name, 4)) = "xlsx" Then ' xls, 또는 xlsx 인 경우'
            '엑셀 파일 열기'
            Dim aBook As Workbook
            Set aBook = Workbooks.Open(c)
            
            '모든시트에 헤더를 넣는 함수 실행'
            For Each tmpsht In aBook.Worksheets
                headerInsertTest tmpsht, imgName
            Next tmpsht
            
            ' 저장하고 닫기'
            aBook.Save
            aBook.Close
        End If
    Next c
    
    For Each d In tmpSubFolders
        
        Dim tmpSub As Object
        Set tmpSubs = fso.GetFolder(d)
        
        ' 하위폴더가 있는경우 하위폴더까지 계속 탐색함 (재귀함수)'
        getDataRecursive tmpSubs, imgName
    Next d
End Sub

Sub headerInsertTest(ByVal sht As Worksheet, ByVal imgPath As String)

    Dim wia         As Object       '이미지 크기 확인을 위한 개체'
    
    Set wia = CreateObject("WIA.ImageFile")
    wia.LoadFile (imgPath)
    
    With sht.PageSetup
        
        With .CenterHeaderPicture       ' 상단 중앙 머릿글에 이미지 넣기'
            .Filename = imgPath
            .Height = wia.Height        ' 이미지의 세로 크기를 입력'
            .Width = wia.Width          ' 이미지의 가로 크기를 입력'
            .ColorType = msoPictureAutomatic
        End With
        .CenterHeader = "&G" ' 헤더에 그림을 표시함'
        .Zoom = 100
    End With
End Sub

좀 길죠? 

여기에는 총 3개의 함수가 들어있습니다.

1. 실제 코드를 실행 시키는 함수 
2. 하위 폴더를 탐색하며 엑셀 파일을 만나면 열어서 시트별로 3번 함수를 실행
3. 워크시트의 머릿글에 이미지를 넣는 함수

이런 순서로 들어있고요. 

1번 함수에서 원하시는 엑셀 파일이 들어있는 경로와 머릿글에 들어갈 이미지의 경로를 지정해 준 뒤 실행하면 됩니다. 제가 실행해 보니 실행 속도가 다소 느리기는 하지만 정상적으로 동작이 잘 되는 군요.

첫번째 함수에서 

    rootPath = "D:\test\xlss"
    imagePath = "D:\test\xlss\diy_header.png"

부분에 이미지의 경로와 엑셀 파일이 들어있는 경로를 바꾸어 주신뒤 동작 시키면 모든 엑셀파일(xls, xlsx)에 아래와 같이 헤더 위치에 원하시는 이미지가 붙게 됩니다. 

참고로 위 스크립트는 머릿글을 붙여야할 문서에 작성하는 것이 아닙니다. 별도 엑셀 파일에 작성한 뒤 동작을 시켜야만 지정한 폴더에 있는 엑셀 파일들을 열어서 자동화 작업이 가능하겠죠.

스크립트가 길어 직접 작성이 어려우실 수 있을 것 같아 작성된 엑셀 파일을 첨부합니다.

해보시고 어려운 부분이 있으면 뎃글 부탁드립니다.

뎃글과 공감은 블로그 작성자에게 큰 힘이 됩니다. 

감사합니다.

2019/06/01 - [DEV/VBA] - 엑셀 VBA 시작하기

2019/08/12 - [DEV/VBA] - [VBA] 문자열 가지고 놀기

2019/12/06 - [DEV/VBA] - [vba] 하위폴더 내의 모든 파일 정보 가져오기

2020/01/08 - [DEV/c#] - Excel Automate, 엑셀 자동화 프로그램

안녕하세요. 이번 강좌에서는 엑셀 시트에 있는 이미지 파일 경로를 이용하여 셀에 이미지를 붙여넣는 스크립트를 한번 알아 보겠습니다. 엑셀에 이미지를 몇장 붙여 넣는 거야 그림 삽입하기로 손쉽게 넣으면 되지만 붙여넣어야 할 그림이 몇백개 이상이 되면 답이 나오지 않는 상황이 옵니다. 절망 적이죠. 바로 야근 각입니다.

하지만 스크립트가 출동한다면 ?

칼퇴근 쌉가능

게다가 셀의 크기에 맞게 가지런히 딱 붙여줄수 있다면 말할 필요도 없이 선배님에게 쓰담쓰담 각 입니다.

어렵지 않으니 천천히 따라와 주시면 됩니다.

*** 개발에 관심 1g도 없고 그림만 자동으로 붙여 넣고 싶으시다면 아래 포스트를 참고해주세요

2020/01/08 - [DEV/c#] - Excel Automate, 엑셀 자동화 프로그램

엑셀에 이미지를 붙여 넣는 방법중에 대표적으로 아래 두가지 방법이 있을 수 있겠습니다.

• Worksheet.Pictures.Insert(pathName & bmpName)
• Worksheet.Pictures.Insert.Shapes.AddPicture(Filename:=(pathName & bmpName), linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=imgPosX, Top:=imgPosY, width:=imgWidth, Height:=imgHeight)

요렇게 두가지 인데요. 

저는 아래의 방법을 선호 합니다. 위의 방법은 코드가 짧고 단순하여 작성이 편리하기는 하지만 엑셀 2007 이하의 버전에서 삽입한 이미지가 2010 버전에서 간혹 누락이 되는 경우가 있습니다. 정확히 원인을 알수는 없지만 두번째 방법은 그런 문제가 없어 현재 두번째로만 사용중입니다.

자 그럼 코드를 작성해 볼까요?

먼저 이미지 이름 (경로 포함 또는 경로는 별도로 설정) 이 있는 셀이 연속으로 있어야 겠습니다.

요런식으로 말이죠.

그럼 코딩을 시작해 보겠습니다. 아래 코드를 봐주세요 전에 작성했던 코드에 비하면 조금 길지만 어렵지 않습니다.

Sub insertPicture()

    Dim aSht As Worksheet
    Dim rngA As Range
    Dim rng8 As Range
    
    Dim pathName As String  '이미지가 들어있는 경로'
    
    Dim imgPosX As Integer
    Dim imgPosY As Integer
    Dim imgWidth As Integer
    Dim imgHeight As Integer
    
    '이미지 정보 확인을 위한 개체를 만들겁니다.'
    Dim wia         As Object
    
    Dim m_Width As Integer
    Dim m_Height As Integer
    
    Dim pic As Shape
    
    Set aSht = ActiveSheet  ' 현재 선택된 시트에서 진행하겠습니다.'
    
    Set rngA = aSht.Range("B2")
    Set rngA = aSht.Range(rngA, rngA.End(xlDown)) ' 요렇게 하면 B2 부터 아래로 맨 끝까지가 설정이 되는거 아시죠?'
    
    Set wia = CreateObject("WIA.ImageFile")     ' 이미지 정보 확인을 위한 오브젝트를 설정함'
     
    pathName = "F:\test\unimog\" '이미지가 들어있는 경로'

    For Each aRng In rngA
    
        Set rng8 = aRng.Offset(0, 1) 'rng8 이라는 변수'
        bmpName = aRng.Value
                
        bmpName = bmpName
        
        ' 이미지가 경로상에 실제 존재하는지 파악하기 위하여 Dir 함수 사용'
        isBmpExist = Dir(pathName & bmpName)
        
        ' 이미지가 없으면 "" 가 리턴됨'
        If (isBmpExist <> "") Then
            
            ' 이미지를 열어서 사이즈를 확인함'
            wia.LoadFile (pathName & bmpName)
            
            m_Width = wia.Width
            m_Height = wia.Height
            
            '이미지의 세로크기가 셀 최대 높이 값을 넘는 경우 최대 높이값으로 설정함
            If (m_Height > 540) Then
                Dim scaleRatio As Double
                scaleRatio = 540 / m_Height
                m_Height = 540
                m_Width = CInt(m_Width * scaleRatio)
            End If
            
            '만약 이미지의 세로 크기가 현재 설정되어있는 셀보다 작다면 셀의 세로 길이를 늘여줌'
            If rng8.RowHeight < (m_Height * 0.75 + 4) Then
                rng8.RowHeight = m_Height * 0.75 + 4
            End If
            
            '이미지가 셀의 중앙에 위치하도록 위치와 크기를 계산하여줌.'
            '엑셀에서의 수치 단위가 px 이 아닌 point 이기 때문에 px 로 계산된 값에 각각 0.75 를 곱해주었다.
            imgPosX = rng8.Left + rng8.Width / 2 - (m_Width * 0.75) / 2
            imgPosY = rng8.Top + (rng8.RowHeight * 0.5 - (m_Height * 0.75 * 0.5))
            imgWidth = m_Width * 0.75
            imgHeight = m_Height * 0.75
            
            '최종 이미지를 위에서 설정한 값으로 삽입하는 과정'
            '복잡하게 계산할거 없이 다 동일한 크기에 동일한 위치라면 imgPosX, imgWidth, imgHeight 는 고정값을 적용해 주어도 된다.'
            Set pic = aSht.Shapes.AddPicture(Filename:=(pathName & bmpName), linktofile:=msoFalse, savewithdocument:=msoCTrue, Left:=imgPosX, Top:=imgPosY, Width:=imgWidth, Height:=imgHeight)
            
            
        End If
   
   Next
   
   Set wia = Nothing
   
End Sub

  좀 특별한 개체로 createObject 라는 함수가 호출이 되었고 그 개체에서 이미지 정보를 확인하는 부분이 들어있는데요. 이는 엑셀에서 COM(Component Object Model) 이라고 하는 오브젝트를 생성하여 기능을 수행하는 과정을 보여줍니다. vba 나 .net 기반의 개발 환경에서 아주 빠르고 손쉽게 여러가지 기능을 사용할 수 있도록 하기 위한 라이브러리 같은 개념이라고 보시면 됩니다. 다만 플랫폼이나 사용자별 환경에 따라 상당히 제약적인 부분이 있으니 남발하는 것은 좋지 않겠습니다.

F5 키를 눌러 실행을 하면 아래와 같이 이미지가 붙게 됩니다.

참고로 엑셀 시트의 확대 배율을 반드시 100% 로 해놓고 실행하셔야 정확하게 셀에 붙습니다. 축소된 상태면 이미지가 밀려 내려가는 경우가 발생할 수 있습니다.

약 31개의 이미지가 붙었는데요. 1초만에 모두 삽입 되었습니다.

제가 작성한 코드를 복사해 가신 후 아래 내용에 경로만 수정해 주시면 바로 사용이 가능합니다.

pathName = "F:\test\unimog\" <-- 이미지가 들어있는 폴더 경로, 끝에 \ 를 붙여줘야 합니다.

물론 이미지 이름이 붙어 있는 range 의 시작 셀의 이름도 설정을 해주어야 겠지요.

Set rngA = aSht.Range("B2") <-- B2 부분에 시작 셀의 이름을 적어주면 됩니다. C3, F1 처럼 말이죠.

어디 메모장이나 노트에 붙여 넣어 두셨다가 필요하실 때 사용하시면 됩니다. 

이상으로 이미지를 한번에 붙여 넣는 자동스크립트를 알아 보았습니다.

2021/01/03 - [DEV/Adobe Script] - [포토샵스크립트] 코딩을 통하여 '모동숲 카드' 만들기

2020/09/04 - [DEV/VBA] - [vba] 엑셀 이미지 리스트로 일괄 다운로드 받기

2020/01/08 - [DEV/c#] - Excel Automate, 엑셀 자동화 프로그램 (그림 자동으로 붙여주는 프로그램)

2020/05/21 - [DEV/VBA] - [Excel] LCD 인치 정보로 가로 세로 길이 알아내는 방법

셀의 크기, 테두리 등을 VBA 로 지정하는 방법

2020/01/30 - [분류 전체보기] - [vba] 셀 속성 조정하기 (넓이, 높이, 숨기기, 테두리 등)

만약 사진을 잘못 붙여넣어서 한번에 다 지워야 한다면?

https://diy-dev-design.tistory.com/30

2020/08/27 - [DEV/VBA] - 재택근무 필수 엑셀 "자리안비움" - 윈도우 꺼짐 방지