반응형

오늘 소개해 드릴 내용은 엑셀 시트에 이미지 파일명과 경로가 있는 상태에서 선택한 이미지만 뷰어로 바로 확인하는 방법 입니다.

이미지가 수백개 들어있는 엑셀 시트에 이미지를 모두 붙여넣는 기능도 사용할 수 있겠지만 이미지가 매우 크거나 이미지가 수시로 업데이트 될 수도 있겠고요, 또 이미지가 너무 많은 경우 이미지를 모두 붙여 넣으면 엑셀 파일의 용량이 매우 커지겠죠.

그럴 때 사용하면 괜찮은 기능입니다.

바로 어떻게 생긴 이미지인지 궁금한 대상만 선택하여 바로 이미지 뷰어로 보는 것이죠.

 

먼저 이미지 파일명이 쭈~ 욱 들어있는 엑셀 파일을 준비하시고 스크립트를 동작시킬 단추를 하나 추가합니다.

상단을 틀고정 같은걸로 고정해 놓으면 리스트를 내려도 단추가 계속 보일 거에요.

단추를 추가하는 방법을 모르고 계시만 아래 포스트를 참고해 주세요
https://diy-dev-design.tistory.com/59

 

이미지 리스트와 단추가 준비된 엑셀

위 엑셀 리스트는 예전에 제가 폴더 내의 파일 정보를 가져오는 스크립트를 이용하여 만든 리스트 입니다.

제가 원하는 기능은 이미지 파일명을 선택하고 버튼을 누르면 윈도우에서 지정된 이미지 뷰어로 해당 파일을 열어서 보여주는 것입니다.

그럼 선택한 셀 정보를 얻어오는 스크립트가 필요하겠고 윈도우 shell 명령으로 이미지 파일을 연결하면 윈도우에서 지정한 이미지 뷰어가 이미지를 열어주겠죠?

먼저 선택한 셀 정보를 얻는 스크립트가 필요하겠죠? 여기를 참고하세요

선택한 셀에 이미지 파일명을 아래와 같이 shell 명령을 사용하면 이미지가 열리게 됩니다.

Dim wsh As Object
    
Set wsh = VBA.CreateObject("WScript.Shell")
wsh.Run imgName

 

전체 코드를 볼까요?

Sub showImage()

    Dim aSht As Worksheet
    Dim currentSelection As Range
    Dim imgExtName As String
    Dim imgName As String
    Dim curext As String
    Dim wsh As Object
    
    Set wsh = VBA.CreateObject("WScript.Shell")
    
    Set aSht = ActiveSheet
    Set currentSelection = Selection.Cells()
    
    imgExtName = ".png.jpg.jpeg.bmp.gif.webp.pct.ico...."
    
    curext = LCase(Right(currentSelection.Value, 4))
    
    If (InStr(imgExtName, curext)) Then ' 현재 선택한 셀 내용 중 이미지 확장자를 가지고 있으면
        imgName = currentSelection.Offset(0, -1).Value & "\" & currentSelection.Value
        If Dir(imgName) <> "" Then
            wsh.Run imgName
            
        End If
    Else
        MsgBox ("이미지 파일명이 들어있는 셀을 선택해 주세요")
    End If
    
End Sub

 

선택한 셀이 이미지 파일명인지 아닌지는 확장자로 검사를 하도록 했습니다. imgExtName 이라는 문자열에 이미지 확장자들을 쭈욱 넣어둔 뒤에 실제 선택한 셀의 텍스트에서 뒤에서 4글자를 떼어낸 뒤에 위에 말씀드린 문자열 중에 포함되는지를 검사하는 것이죠.

아주 정교한 방식이라고 볼 수는 없지만 간단하게 구현할 수 있는 이미지 검출 방식이라 할 수 있겠습니다.

어쨌든 이렇게 이미지 파일명이 맞는지 확인한 뒤에 앞에있는 경로명과 결합해서 해당 이미지가 실제로 존재하는 이미지 인지 추가로 확인한 뒤에 shell 명령을 통해 이미지를 열어주게 됩니다. 

저는 바로 왼쪽 옆칸에 경로가 있어 offset(0,-1) 과 같은 방법으로 연결하였지만 별도 셀에 이미지 경로가 들어있다면 해당 경로를 따로 지정해 주거나 스크립트 내에 문자열로 넣어 주셔도 되겠습니다.

이렇게 만들어진 매크로를 버튼에 연결하는 방법은

버튼을 최초 생성할때도 보였겠지만 매크로를 연결하는 메뉴가 있습니다. 단추에서 오른쪽 클릭한 다음 "매크로지정" 을 선택하면 매크로 선택창이 나타나게 되는데요, 여기서 지금 만들어준 스크립트를 선택해주면 됩니다.

매크로 지정하는 과정

 

자 이제 어떻게 동작하는지 한번 볼까요?

먼저 이미지 들이 들어있는 폴더가 있을 거고요. 만약 이미지가 아닌 셀을 선택하면 경고창을, 이미지 이름을 선택하면 윈도우 이미지 뷰어로 바로 열리게 됩니다.

선택한 이미지가 열리는 기능이 실제 동작되는 화면

 

자 간단하게 원하는 기능이 구현되었습니다.

필요하신 분들은 소스 복사하셔서 사용하시면 될 것 같고요. 잘 응용하셔서 본인의 엑셀 문서에 딱 맞는 기능으로 추가하시면 되겠습니다..

 

그럼 이만~

반응형
반응형

안녕하세요. 오늘은 엑셀 리스트로 가지고 있는 웹 이미지 경로를 이용하여 일괄 다운로드 하는 방법을 소개해 드릴까 합니다. 

인터넷에 찾아보면 이런저런 다운로더들이 있는데요. 입맛에 맞는 프로그램을 찾는 것도 일이고 프로그램이 원하는 형식으로 다운로드용 이미지 리스트를 작성하는것도 번거롭더군요.

이미 엑셀로 이미지 리스트의 웹 주소가 있는데 그냥 엑셀만으로 다운로드 할 수 있을까 해서 좀 찾아 보았습니다. 찾아보니 괜찮은 레퍼런스들이 좀 있었는데요. 사용하기 번거로워 보여 직관적으로 손쉽게 사용할 수 있도록 코드를 좀 손보았습니다.

사실 제가 필요했던 상황이기도 해서 당장 급하게 찾았던 것인데 시간도 없고 별도 프로그램 찾는것 보다 레퍼런스를 이용해서 직접 수정해서 코딩하는게 더 빠르더군요.

저의 경우에는 무려 7000 장 이상의 이미지를 로컬로 내려받아서 확인을 해야 하는 상황이었는데요. 개발팀에 요청하니 4일이나 걸린다고 하더군요. 물론 그 분들도 다른 일정이 있었기 때문이었겠지만 저는 그렇게 기다릴 수는 없었습니다.

 

일단 저의 경우를 기준으로 설명드릴 수 는 없고 일반적인 상황을 가정해 보겠습니다.

엑셀의 A열에 이미지 7000장의 인터넷 경로가 있습니다. 

엑셀의 B 열에는 로컬에 저장되어야 할 이미지 파일명을 준비해 놓았다고 하면 아래의 코드로 간단하게 다운로드 할 수 있습니다.

 

 

엑셀을 이용하여 일괄 이미지 다운로드 하는 방법

 

alt + F11 을 눌러 vba 창을 열어준 뒤 아래 코드를 현재 통합 문서의 스크립트 창에 붙여 넣어 주세요.

그런다음 이미지 주소가 들어있는 열의 첫번째 셀의 이름, 저장할 이미지가 들어있는 열까지의 offset 등을 설정해 준뒤 F5 키를 눌러 실행해 주면 됩니다. 이때 키보드 커서가 Sub 함수 안에 있어야 바로 실행이 되고요, 그렇지 않은 경우 실행할 함수를 한번 선택해주는 창이 뜰텐데 downloadAllImage 를 선택해 주시면 됩니다.

Option Explicit

Sub downloadAllImages()

    Dim asht As Worksheet
    Dim rngA As Range
    Dim c As Range
    Dim sPath As String
    Dim extensions() As String
    
    Set asht = ActiveSheet
    Set rngA = asht.Range("a2") ' 이미지 리스트가 존재하는 첫번째 셀 '
    
    Set rngA = asht.Range(rngA, rngA.End(xlDown))
    
    sPath = "d:\ImageAutoDownload_test\\" ' 저장할 경로를 넣으세요'
    
    For Each c In rngA
        Dim myURL As String
        If Len(c.Value) Then
            Dim imgName As String
            
            imgName = c.Offset(0, 1).Value   ' 이미지별 저장할 이름이 기록된 열 '
            
            myURL = c.Value
            extensions = Split(myURL, ".") ' 확장자가 3글자가 아닐수도 있으므로 확장자를 판별해내기위한 배열 생성
                
            imgName = imgName & "." & extensions(UBound(extensions)) '위에서 구한 배열에서 확장자를 꺼내자
            
            WebFileDownload myURL, imgName, sPath
            
        End If
    
    Next c

End Sub


Public Function WebFileDownload(ByVal strURL As String, ByVal saveFileName As String, ByVal savepath As String) As Boolean
    Dim Buf() As Byte, oWinHttp
On Error GoTo Err_Sub
    Set oWinHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    With oWinHttp
        .Open "GET", strURL, 0
        .Send
        Buf = .ResponseBody
    End With
    Open savepath & saveFileName For Binary Access Write As #1
    Put #1, , Buf
    Close #1
       
    Set oWinHttp = Nothing
       
Err_Sub:
    If Err Then MsgBox Err.Description
    If Not oWinHttp Is Nothing Then Set oWinHttp = Nothing
    
End Function

 

어떠신가요? 복잡하지 않죠? 정상적으로 코드를 옮기고 세팅을 하셨다면 아마 잘 동작하실 겁니다.

 

이미지 7000 장을 하나하나 링크 복사해서 브라우저에 붙여넣고 다른이름으로 저장하고... 또 복사하고 붙여넣고 다른이름으로 저장하고... 했을걸 생각하면 정말 토나오는 일이지요. 만약 정말 일일이 수동으로 위와 같이 진행했다면 몇 일을 해야 했을 지도 모릅니다.

저의 경우엔 7000장 내려받는데 코딩하는 시간을 포함해서 20분만에 끝났습니다. ^^

이런게 바로 디자이너면서 개발하는 맛이지요. 

 

어쨌든 다운로드할 이미지 리스트를 가지고 계신데 적당한 툴이 없어 고민이셨던 분이 있으시다면 도움이 되었길 바랍니다.

 

2022-2-24일 수정

확장자가 3글자가 아닌 경우도 있을 수 있어 주소에서 유동적으로 확장자를 가져올 수 있도록 수정하였습니다.

'선택적 인수가 아닙니다.' 라는 오류가 나는 부분이 있어 내용 수정하였습니다. 함수 호출 시 저장할 경로인 sPath 가 누락되어 있었네요. 

 

 

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

2020/06/22 - [DEV/VBA] - [vba] 초등학교 연산 자동 문제집 - 곱셈 추가

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

2019/10/01 - [DEV/VBA] - [VBA] 엑셀 VBA로 포토샵 연동이 가능할까?

 

반응형
반응형

안녕하세요. 코로나19 바이러스 이슈사 해결되는 듯 해결되지 않고 계속 지속되어 국민 모두가 힘든 시기입니다. 저와 같은 회사원들도 재택근무를 지속하느라 업무효율도 낮고 힘든 시기입니다.

얼마전에 제가 재택근무 필수 유틸로 '자리안비움' 이라는 유틸을 하나 올렸었는데요.

2020/03/09 - [DEV/c#] - 재택근무 필수 유틸 "자리안비움" - 윈도우 꺼짐 방지

 

재택근무 필수 유틸 "자리안비움" - 윈도우 꺼짐 방지

요즘 코로나 바이러스 때문인지 덕분인지 재택근무를 하는 분들이 많은데요. 막상 집에 있다 보면 사무실에 있을 때 처럼 연속해서 자리에 머무르지 못하는 경우가 종종 있습니다. 애들이나 와�

diy-dev-design.tistory.com

회사의 보안 문제로 해당 유틸리티가 구동이 되지 않는 분들이 계서서 엑셀로 비슷한 기능을 하는 버전을 하나 만들어 보았습니다.

엑셀 버전 자리안비움 V2

작동 하는 방법은 간단합니다.

타이머 간격 옆부분에 숫자를 입력합니다. 해당 숫자는 마우스가 움직이지 않는 시간을 지정합니다.

그런다음 '시작' 버튼을 누르면 동작 하게 되는데요. 

마우스가 지정한 시간만큼 움직임이 없으면 잠깐 마우스 커서를 이동시키는 기능을 수행합니다.

'중지' 버튼을 누르면 처음 설정한 시간으로 시간이 리셋되고 기능 동작이 멈춥니다.

모니터 절전 방지 기능은 넣지 않았고요. 마우스만 제어가 됩니다. 

모니터 절전 기능까지 동일하게 동작 됩니다.  시작을 누르면 ON 상태가 되며 중지를 누르면 OFF 로 바뀌도 기능이 중단 됩니다.

하드디스크 꺼짐, 최대절전모드 진입 등의 제어는 이루어지지 않으니 컴퓨터가 꺼진다면 확인해 보세요.

 

엑셀 한켠에 해당 파일을 열어두고 '시작' 버튼을 눌러 놓으면 시스템이 자리비움으로 변경되지 않는 것이지요.

반응형

'ㅎㅎ

물론 우리들은 누가 지켜보든 지켜보지 않든 열심히 일을 하지만 피치 못하는 상황으로 자리를 비워야 하는 일이 있을 수도 있지 않겠습니까? 그런데 회사에서는 자리를 지키고 앉아 있는지만 모니터링 하는 한심한 상사도 있게 마련이지요. 

암튼 뭐 좋은 목적으로 사용하시리라 믿습니다.

아래 파일을 다운로드 받으셔서 사용하시면 되며 초기 구동시 엑셀 매크로에 대한 허용 권한을 허용해 주셔야 합니다.

zarianbium_excel.xls
0.05MB

해당 엑셀 파일에 vba 를 이용하여 마우스를 제어하는 코드도 들어있으니 공부하실 분들은 다운로드 받으셔서 살펴보시기 바랍니다 ^^

 

 

20200901 내용 추가

- 유틸 버전 자리안비움과 동일한 모니터 절전 기능을 추가하였습니다.

20230512 내용 추가

- 어플처럼 마우스 클릭 기능을 추가하는 방법을 소개해 드립니다. 직접 하시면 됩니다.

  • 다운로드 받은 엑셀 파일을 열어놓고 alt+F11 키를 눌러줍니다 --> vba 편집창 나타남
  • 중간코드 중에 waitTime 부분을 아래와 같이 수정합니다. Call click 추가

이랬던 코드를
요렇게 3줄 추가하여 수정해 줍니다.

요렇게 하면 마우스가 이동한 뒤에 클릭! 원래 위치로 돌아와서 클릭! 하는 동작이 추가 됩니다.

스카이프 기반 메신저가 자리비움이 안먹는다는 분들이 계신데.. 요렇게 테스트 해보니 자리비움으로 바뀌지 않는 것을 확인했습니다. 

정지 했다가 한번 다시 시작하시면 적용 됩니다.

 

그럼 이만~

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

2020/06/22 - [DEV/VBA] - [vba] 초등학교 연산 자동 문제집 - 곱셈 추가

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

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

2019/10/24 - [DEV/VBA] - [vba] 버튼(단추)를 이용하여 스크립트 실행하기

반응형
반응형

안녕하세요 주인장입니다.

코로나로 인한 개학연기로 아이들이 집안에서만 딩굴딩굴 거려 답답하신가요?

아이들에게 신나는 연산 문제를 내 주는건 어떨까요?

 

??

 

는 아니고 VBA 로 제가 그동안 덧셈, 뺄셈을 자동으로 만드는 방법을 소개해 드렸었는데요, 이번에는 두자릿수 곱셈문제를 추가해 보았습니다. 

아이들의 계산 공간을 위하여 기존의 가로 문제가 아닌 세로 연산 레이아웃이 필요했고요.

문제수를 조금 줄여 보았습니다.

문제는 난이도를 조금 조정할 수 있는 데 계산에 사용되는 최대 숫자의 크기 제한을 서서히 높이는 방식으로 구성하였으므로 엑셀 VBA 를 조금 이해하시는 분이라면 직접 수정하여 사용하시는 것도 가능합니다.

 

그냥 간단히 설명 드리자면 문제의 난이도를 수정하려면 아래의 순서로 하시면 됩니다.

버튼 --> 마우스 우클릭 --> 매크로 지정 --> 매크로창에서 선택되어 있는 매크로 편집 --> 최대값 변경

 

선우수학숙제..xls
0.08MB

 

 

그리고...

 

채첨해보시면서 일일이 계산하는 것도 번거로운 일인듯 하여 정답보기 버튼을 추가로 넣었습니다.

문제를 출제 --> 프린트 --> 정답보기 --> 채점 또는 프린트 하여 채점 하는 식으로 사용하시면 됩니다.

다시 문제를 내버리면 이전에 만들어진 문제는 사라지므로 그렇게 된 경우엔 채첨하실때 직접 계산을 하시는 수 밖에 없답니다.

 

아들내미가 이걸로 며칠 하더니 연산 실력이 부쩍 올랐습니다. 늘 하던 실수도 많이 줄더군요.

그리고는 하는말이 우리 선생님한테 이런게 들어가지 않았으면 좋겠다고 하더라고요. ㅋㅋ. 매일 쪽지시험보면 어쩌냐고요.. 

 

 

선생님들. 어머님들 너무 심하게 시키지는 말아주세요~

 

본 포스트에 첨부된 엑셀 파일로 덧셈, 곱셈, 뺄셈을 모두 출재하실 수 있으니 기존의 포스트는 참고만 하시면 될 것 같습니다. 

 

그럼 더운 여름 코로나로 답답한 아이들에게 시원한 연산문제를 선물해줘보세요~

2019/09/10 - [DEV/VBA] - [VBA] 엑셀로 초등학교 저학년 문제집 만들기 (자동버전)

 

[VBA] 엑셀로 초등학교 저학년 문제집 만들기 (자동버전)

이번 포스트를 통해 꼬마아이들의 공공의적 이 될런지도 모릅니다. 바로 초등 저학년 연산문제를 끝도 없이 만들수 있는 파일을 준비했기 때문입니다. 지난번 포스트에서 연산문제를 만드는 VBA

diy-dev-design.tistory.com

 

2020/04/17 - [DEV/VBA] - [vba] 초등학교 연산 문제 자동 출제, 이번엔 뺄셈에 도전

 

[vba] 초등학교 연산 문제 자동 출제, 이번엔 뺄셈에 도전

VBA를 이용하여 초등학교 연산 문제를 내는 것을 만들어 올린적이 있었습니다. 개학이 늦어지면서 집안에서 아이들 공부시키랴 밥해먹이랴 엄마들이 고생이 많을텐데요. 그사이 아이들의 학습 �

diy-dev-design.tistory.com

 

스크립트의 원리가 궁금하시다면 아래 포스트를 참고해주세요.

2019/09/03 - [DEV/VBA] - [VBA] 초등학교 저학년 수학 연산 문제 자동으로 만들기

 

[VBA] 초등학교 저학년 수학 연산 문제 자동으로 만들기

안녕하세요. 이번 강좌에서는 VBA 를 이용하여 초등학교 저학년 아이를 위한 연산문제를 자동으로 내주는 스크립트를 작성해 보겠습니다. VBA 를 좀 해봤다 하면서 막상 일상 생활에 사용하려면 �

diy-dev-design.tistory.com

 

이참에 본격적으로 VBA 도 한번 배워 보고 싶으시다면? 

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

 

엑셀 VBA 시작하기

마이크로 소프트 엑셀은 수많은 기능과 자동화된 연산 처리, 편리한 템플릿 가공, 다양한 그래프 드을 이용한 데이터의 시각화 외에도 아주 많은 유용한 기능을 제공하여 사무 업무의 표준 프로

diy-dev-design.tistory.com

 

반응형
반응형

이번에 소개해드릴 부분은 시트간 데이터를 비교하는 방법입니다.

VBA 로 뭔가를 하게되면서 가장 유용하게 많이 사용하는 것 중 하나죠.

예를 들면 Sheet1 에 어떤 데이터 리스트가 있고 Sheet2 에 똑같은 유형의 업데이트 된 다른 리스트가 있다고 했을 때 두 데이터를 비교해서 차이가 있는 것을 마킹한다던가 특정 값이 더 높은 데이터를 찾는다든가 아니면 B 의 시트에서 A에 공통으로 있는 항목만 찾는 등의 작업을 할때 아주 유용한 개발 내용입니다. 이런 류의 작업을 눈으로 사람이 한다는건 데이터의 양에 따라 다르기는 하지만 데이터가 1000개 또는 10000개가 넘는다면 정말 말도 안되는 작업이죠.

 

일단 기본 개념은 아래와 같습니다.

  • 변수 선언
    • 두개의 시트를 지정할 변수를 선언한다. (worksheet)
      • 만약 두개의 시트가 각각 다른 엑셀문서에 존재한다면 엑셀 문서지정을 위한 변수를 선언한다. (workbook)
    • 두 시트에 비교해야할 영역을 설정하기 위한 변수를 각각 선언한다. (range)
  • 실제 코드 부분
    • 엑셀문서와 시트를 설정한다
    • 각각의 영역을 설정한다
    • A 영역을 반복하여 도는 For 구분을 만든다
      • A 영역을 한번 반복하는 동안 B 영역을 반복하는 For 구분을 삽입한다.
      • 필요한 조건문을 작성하여 조건에 해당되는 경우 특정 액션을 수행한다.

이런 식이 됩니다.

처음 보시는 분은 어리둥절 할 수도 있지만 막상 몇번 코딩을 해보면 아주 간단한 구문 입니다.

아래 간단한 예제를 한번 볼까요?

 

하나의 엑셀파일에 있는 두개의 시트를 비교하는 방법입니다.

Sub check()

    Dim shtA As Worksheet
    Dim shtB As Worksheet
    
    Dim rngA As Range
    Dim rngB As Range

    Set shtA = Worksheets("Sheet1") '워크시트의 이름을 넣으세요'
    Set shtB = Worksheets("Sheet2") '워크시트의 이름을 넣으세요'
    
    Set rngA = shtA.Range("A2") '첫번째 시트의 비교할 시작행의 번호를 넣으세요'
    Set rngA = shtA.Range(rngA, rngA.End(xlDown)) '세로로 데이터가 있는 끝까지 자동으로 설정합니다'
        
    Set rngB = shtB.Range("A2") '두번째 시트의 비교할 시작행의 번호를 넣으세요'
    Set rngB = shtB.Range(rngB, rngB.End(xlDown)) '세로로 데이터가 있는 끝까지 자동으로 설정합니다'
    
    For Each c In rngA
        c.Interior.Color = xlNone '초기 색상을 없애 줍니다'        
        For Each d In rngB
        	if c.value = d.value then '해당되는 칸의 값이 같을 경우'
            	
                ' 오른쪽 바로 옆칸의 값이 다를경우'
                if c.offset(0,1).value <> d.offset(0,1).value then
                	c.Interior.Color = RGB(255,0,0) '빨간색으로 셀을 색칠한다'
                end if
                
                '동일한 값이 한번이 있고 넘기려면 반복을 끝낸다'
                Exit For                
            end if        
        next d        
    Next c
    
End Sub

간단하지요?

반복문안에서 다시 반복을 하면서 값을 찾아내는 방법입니다. 간단하지만 아주 유용한 방법입니다.

 

 

 

다른 엑셀파일에 있는 정보를 비교하려면?

만약 두개의 다른 엑셀 시트에 있는 시트를 비교해야 한다면 위에서 소개한 코드에 워크북을 설정해주는 부분만 추가하면 됩니다.

워크북은 아래와 같이 설정하게 되죠.

Sub check()
	
    Dim bookA as Workbook '워크북 변수'
    Dim bookB as Workbook '워크북 변수'
    
    Dim shtA As Worksheet
    Dim shtB As Worksheet
    
    Dim rngA As Range
    Dim rngB As Range
    
    set bookA = Workbooks("firstExcelFile.xlsx")'첫번째 엑셀 파일명을 입력, 확장자 포함'
    set bookB = Workbooks("secondExcelFile.xlsx")'두번째 엑셀 파일명을 입력, 확장자 포함'
    
    set shtA = bookA.Worksheets("Sheet1")
    set shtB = bookB.Worksheets("Sheet2")
    
    ' 이하 동일 '
    

 

역시 간단하죠?

저런 방식으로 두개의 엑셀 파일 또는 그 이상의 엑셀 파일을 지정하여 값을 비교할 수 있습니다.

 

 

다른 시트의 값을 찾아 원본 시트에 동일한 명칭에 가져오는 방법

만약 반복 구문을 도는 동안 두번째 데이터의 값에서 동일한 명칭을 찾아 그에 해당되는 값을 첫번째 시트에 넣는다면 아래와 같이 하면 됩니다. 실제로 찾아서 값을 넣은 개수도 확인할 수 있도록 해보겠습니다. 

 

Sub check()

    Dim shtA As Worksheet
    Dim shtB As Worksheet
    
    Dim rngA As Range
    Dim rngB As Range
	
    Dim matchingNumber as integer '매칭된 대상 개수 파악용'
    
    Set shtA = Worksheets("Sheet1") '워크시트의 이름을 넣으세요'
    Set shtB = Worksheets("Sheet2") '워크시트의 이름을 넣으세요'
    
    Set rngA = shtA.Range("A2") '첫번째 시트의 비교할 시작행의 번호를 넣으세요'
    If Len(rngA.Offset(1, 0)) Then ' 만약 시트에 데이터가 딱 한줄일 경우 아래쪽까지 range 를 설정하지 않는다.'
    	Set rngA = shtA.Range(rngA, rngA.End(xlDown)) '세로로 데이터가 있는 끝까지 자동으로 설정합니다'
    end if
    
    Set rngB = shtB.Range("A2") '두번째 시트의 비교할 시작행의 번호를 넣으세요'
    if  Len(rngB.Offset(1, 0)) Then ' 만약 시트에 데이터가 딱 한줄일 경우 아래쪽까지 range 를 설정하지 않는다.'
    	Set rngB = shtB.Range(rngB, rngB.End(xlDown)) '세로로 데이터가 있는 끝까지 자동으로 설정합니다'
    end if
    
    For Each c In rngA
        c.Interior.Color = xlNone '초기 색상을 없애 줍니다'        
        For Each d In rngB
        	if c.value = d.value then '해당되는 칸의 값이 같을 경우'
            	'명칭이 같은 정보의 바로 옆 같의 값을 복제하여 가져온다'
                c.offset(0,1).value = d.offset(0,1).value
                
                matchingNumber = matchingNumber + 1
                
                '동일한 값이 한번이라도 있는 경우 바로 종료 하려면 아래 주석을 풀어주세요'
                'Exit For    '            
            end if        
        next d        
    Next c
    
    MsgBox("매칭된 개수는 " & matchingNumber & " 입니다.")
    
End Sub

이렇게 하면 다른시트에서 비교한뒤 동인한 명칭을 갖는 행의 값을 가져오면서 가져온 개수를 알 수 있습니다.

 

참 쉽죠?

 

궁금하거나 다른 문의사항이 있으면 뎃글로 남겨주시면 감사하겠습니다.

감사합니다.

본 포스트를 보신 후 
도움이 되었다 생각되시면 공감 클릭!!  부탁드려요~

 

 

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

2019/08/01 - [DEV/VBA] - [vba] 현재 엑셀 시트의 선택한 영역을 vba 스크립트에서 가져오기

2019/07/12 - [DEV/VBA] - [vba] For 구문 이용하기와 offset 사용 해 보기

2019/08/30 - [DEV/VBA] - [VBA]RGB 색상 값이 들어있는 셀에 셀 색상 지정하기

2019/09/02 - [DEV/VBA] - [vba] 엑셀 시트의 모든 색상의 셀 색상 제거하기

2019/10/24 - [DEV/VBA] - [vba] 버튼(단추)를 이용하여 스크립트 실행하기

 

 

반응형
반응형

VBA를 이용하여 초등학교 연산 문제를 내는 것을 만들어 올린적이 있었습니다. 개학이 늦어지면서 집안에서 아이들 공부시키랴 밥해먹이랴 엄마들이 고생이 많을텐데요. 그사이 아이들의 학습 진도가 늦어질까 걱정하여 학습지를 하는 분들도 많더라구요.

간단한 덧셈, 뺄셈은 굳이 돈을 들여 학습지를 하실 필요가 없습니다. 또 초등학교 선생님들께서도 다운로드 받아 놓으시면 손쉽게 문제를 낼 수 있으니 아이들 간단한 쪽지 시험을 내야 하는 경우 사용하시기에도 안성 맞춤일 것 같습니다.

제가 만든 엑셀 파일만 있으면 수천장도 만드는게 가능하니까요. 아이들을 위하여는 적당히 시키는게 좋겠지만 또 막상 연산에 재미 붙일 시기에 문제를 만드느라 고생하실 필요가 없다는 것이지요. 아이들아 미안하다... 

 

아래 링크된 파일을 받으시면 빼기 기초 시트에 문제가 들어 있습니다.

 

선우수학숙제.xls
0.07MB

 

뎃글, 공감 은 블로그 작성자에게 큰 힘이 된답니다. 

 

 

 

 

파일을 다운로드 받으신 후 열어 보시면 아래와 같이 뻴셈 문제가 나와 있는 시트가 있습니다.

하단의 텝을 보면 기존의 더하기 문제도 보인다.

 

문제를 새로 내실 때에는 우측의 버튼을 이용하여 문제를 새로 내실 수가 있습니다. 유치원 수준의 아주 쉬운 문제도 가능합니다.

우측의 버튼을 차례로 눌러보시면 각각 난이도 별로 문제가 나오는 것을 확인하실 수 있으실 텐데요. (쉬움) 은 뺄셈 과정에서 앞자리수가 바뀌지 않는 뺄셈이라고 보시면 됩니다. 

예를 들면 18 - 5 처럼 실제로는 뒷자리만 연산이 일어나죠.

만약 문제내기가 동작이 되지 않는다면 보안 수준을 낮추어 주면 됩니다. 

메뉴의 "파일" --> "옵션" --> "보안센터" 로 들어 갑니다.

보안센터 버튼

 

들어가셔서 매크로 설정의 보안 수준을 낮추어 주어야 하는데요. 직업상 외부 엑셀 파일을 늘 다운로드 받아야 하는 경우라면 문제내기를 마치면 원상복구를 해놓는 것이 좋습니다. 엑셀 VBA 는 매우 강력한 언어로 시스템의 많은 것들을 제어할 수 있는 언어 입니다. 주의 하는것이 좋겠죠.

모든 매크로 포함으로 변경

 

이렇게 하시면 제가 만들어 드린 문제 내기 기능이 동작할 것입니다.

 

현재 화면 영역은 A4 용지에 딱 맞게 만들어져 있기 때문에 바로 프린트 하시면 됩니다.

 

 

 

 

아이들이 문제 푸는것을 좋아할리는 만무하겠지만 그렇다고 온종일 집에서 휴대폰만 만지작 거리게 할수도 없지 않을까요? 간단한 연산 문제로 두뇌도 좀 풀어주고 무엇인가 계속해서 해나가고 있다는 성취감도 주면 좋을 것 같습니다.

이제 온라인 개학이 학교마다 진행되고 있습니다만 아이도, 부모님도, 선생님들도 모두 힘든 시기가 아닐까 생각됩니다. 

모든 분들께서 조금이나마 힘을 내시라고 이런 것이라도 올려 봅니다. 

(물론 아이들은 힘빠지는 포스트이려나요 ㅎㅎ)

 

아 그리고 제가 시트보호는 걸어 두었지만 비주얼 베이직 코드는 모두 보실수 있답니다. Alt + F11 키를 누르시면 제가 만든 엑셀의 계산 과정이 코드로 나와 있습니다. 코드에 관심이 있으신 분은 참고하시면 좋을 것 같습니다.

덧셈 문제는 각각의 문제마다 코드가 작성이 되어 있고요. 뺄셈은 하나의 함수로 모든 문제내기에 대응이 가능한 방식 힙니다. 뺄셈에 적용된 코딩 방식이 좀더 효율적인 코드라고 할 수 있겠습니다. 관심이 있으셨던 분이라면 한번 열어서 보시길 바랍니다. 

 

뎃글, 공감 은 블로그 작성자에게 큰 힘이 된답니다. 

 

비주얼 베이직으로 연산 문제를 내는 방법은 아래 글을 참고해 주세요

2019/09/03 - [DEV/VBA] - [VBA] 초등학교 저학년 수학 연산 문제 자동으로 만들기

 

[VBA] 초등학교 저학년 수학 연산 문제 자동으로 만들기

안녕하세요. 이번 강좌에서는 VBA 를 이용하여 초등학교 저학년 아이를 위한 연산문제를 자동으로 내주는 스크립트를 작성해 보겠습니다. VBA 를 좀 해봤다 하면서 막상 일상 생활에 사용하려면 사용할데가 마땅히..

diy-dev-design.tistory.com

2019/09/10 - [DEV/VBA] - [VBA] 엑셀로 초등학교 저학년 문제집 만들기 (자동버전)

 

[VBA] 엑셀로 초등학교 저학년 문제집 만들기 (자동버전)

이번 포스트를 통해 꼬마아이들의 공공의적 이 될런지도 모릅니다. 바로 초등 저학년 연산문제를 끝도 없이 만들수 있는 파일을 준비했기 때문입니다. 지난번 포스트에서 연산문제를 만드는 VBA 를 소개해 드렸었..

diy-dev-design.tistory.com

 

 

 

 

곱셈까지 추가된 버전으로 한번에 사용하시려면?

2020/06/22 - [DEV/VBA] - [vba] 초등학교 연산 자동 문제집 - 곱셈 추가

 

[vba] 초등학교 연산 자동 문제집 - 곱셈 추가

안녕하세요 주인장입니다. 코로나로 인한 개학연기로 아이들이 집안에서만 딩굴딩굴 거려 답답하신가요? 아이들에게 신나는 연산 문제를 내 주는건 어떨까요? ?? 는 아니고 VBA 로 제가 그동안 ��

diy-dev-design.tistory.com

 

 

반응형
반응형

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

 

"엑셀파일 수백개가있는데
파일의 시트마다 머리글에 이미지를 삽입해야합니다
이런것도 가능한가요?
아니면 만들어주신 프로그램에서 2행정도를 추가한뒤에 전체시트에 한번에 입력하는것도 가능한지요?"

출처: https://diy-dev-design.tistory.com/84?category=793981 [개발하는 디자이너의 DIY 일상]

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

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

 

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

 

 

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

Worksheet.PageSetup.LeftHeaderPicture.Filename = "이미지 파일 경로"
Worksheet.PageSetup.LeftHeader = "헤더에 입력할 텍스트"

 

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

Worksheet.PageSetup.붙일위치/타입

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

그림을 넣을 경우

LeftHeaderPicture  CenterHeaderPicture  RightHeaderPicture
본문
LeftFooterPicture  CenterFooterPicture  RightFooterPicture

 

글자를 넣을 경우

LeftHeader   CenterHeader  RightHeader
본문
LeftFooter   CenterFooter  RightFooter

 

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

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)에 아래와 같이 헤더 위치에 원하시는 이미지가 붙게 됩니다. 

모든 엑셀파일 및 시트에 위와 같이 머릿글 자리에 이미지가 붙었다.

 

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

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

insertHeader_all.xls
0.04MB

 

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

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

 

감사합니다.

 

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

 

엑셀 VBA 시작하기

마이크로 소프트 엑셀은 수많은 기능과 자동화된 연산 처리, 편리한 템플릿 가공, 다양한 그래프 드을 이용한 데이터의 시각화 외에도 아주 많은 유용한 기능을 제공하여 사무 업무의 표준 프로그램이 되었다. 나..

diy-dev-design.tistory.com

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

 

[VBA] 문자열 가지고 놀기

안녕하세요. 이번 글에서는 VBA 에서 문자열을 가지고 무엇인가를 하는 것을 알아보겠습니다. 프로그래밍을 하다 보면 조건을 가지고 어떤 액션을 해야 하는 결우가 무척 많은데요. 그중에 대표적인 것의 하나가..

diy-dev-design.tistory.com

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

 

[vba] 하위폴더 내의 모든 파일 정보 가져오기

일을 하다 보면 가끔 업무를 진행하던 경로 하위에 있는 데이들의 리스트를 만들어야 하는 경우가 있습니다. 하나의 폴더라면 어떻게 해보겠는데 그 폴더가 하위 뎁스가 연속해서 있고 저장되어 있는 파일이 불특..

diy-dev-design.tistory.com

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

 

Excel Automate, 엑셀 자동화 프로그램

필자의 블로그 명칭을 보고 이미 알고 계신분이 있을지 모르겠지만 사실 저는 디자이너 입니다. 하지만 블로그에 맨 개발 관련 된 이야기만 적고 있지요. 음... 그런데 실제로 회사에서도 저는 대부분의 시간을 코..

diy-dev-design.tistory.com

 

반응형
반응형

엑셀 파일을 이용하여 정말 다양한 작업이 가능합니다. 계산이며 표만들기며 각종 정보를 분석하거나 데이터 화 시키는 작업 등 정말 할 수 있는 일이 무궁무진 하죠. 그런데 가끔 엑셀을 이용하여 특정 정보를 별도로 텍스트 등으로 저장해야 하는 경우가 있습니다. 개발 쪽에서 어떤 데이터 리스트를 csv 형태로 요구하였는데 그러기 위하여는 굳이 정보를 재 가공 해야 하는 경우라던가 자료의 특성상 데이터를 가공하는 위험 부담이 있는 경우에는 좀 부담스럽죠.

필요한 필드만 또는 특정 필드의 값들을 특정 형태로 가공해서 저장하고 싶을 때 스크립트를 이용하여 파일 쓰기를 해 줄 수 있다면 큰 도움이 될 겁니다.

아니면 HTML 이나 CSS 처럼 엑셀에 있는 정보들을 특정한 포멧에 맞게 뽑고 싶은데 엑셀의 저장 기능에는 그런것은 없기 때문에 코딩을 할 수 있게 되면 활용 범위가 더욱 커지고 불필요한 노동을 줄일 수 있습니다.

 

오늘은 엑셀에서 텍스트 파일 형태로 파일을 추출하는 간단한 방법을 알아보도록 하겠습니다.

 

코드는 대충 아래와 같습니다.

Open FILE_NAME For Output As #1
Print #1, YOUR_STRING
Close #1

아주 간단하죠? 간단해서 제가 자주 사용하는 코드 입니다.

FILE_NAME 부분에 실제 저장되어야 할 파일 명을 경로를 포함하여 적어주시고요 저장하고 싶은 텍스트를 YOUR_STRING 부분에 넣으면 해당 파일을 기록하고 닫는 코드 입니다.

손쉽게 사용하기 위하여 함수 형태로 만들면 아래와 같이 되겠습니다. 물론 너무 짧아서 굳이 함수로 만들 필요도 없기는 하지만요.

Sub writeMyFile (byVal strPath as string, byVal currentText as string)
	Open strPath For Output As #1
	Print #1, currentText
	Close #1
End Sub

'사용할때 '

sub test()
	dim myString as string
	myString = "hello" & vbNewLine
	myString = myString & "DIY" & vbNewLine
	myString = myString & "DEV" & vbNewLine
	myString = myString & "DESIGN" & vbNewLine
	
    writeMyFile "d:\test.ini", myString
end sub

 

아래 test 라는 함수에서 실제 텍스트를 써주는 부분을 호출하고 아래와 같은 파일이 만들어 지게 됩니다.

보시는 것처럼 vbNewLine 과 같은 줄바꿈 기호 등을 줄의 맨뒤에 추가하여 여러줄을 동시에 기록하는 것도 가능합니다.

제가 만든 test 부분에서 기록하고 싶은 여러 내용을 포멧에 맞게 변수에 저장을 한 뒤 마지막에 파일을 써주는 함수에 보내면 원하는 형식으로 텍스트 파일이 만들어 지는 것이죠.

 

자 손쉽게 엑셀의 자료를 텍스트 파일로 기록해 주는 함수를 만들어 보았습니다. 스트링 형식으로 저장된 내용을 그냥 기록만 해주면 되기 때문에 해당 기능을 이용하여 자바스크립트, CSS, HTML 등의 형식으로 손쉽게 저장하 실 수 있습니다.

참고로 저는 이미지를 붙여 넣는 기능과 함께 해당 이미지를 웹 브라우저를 통해 미리 볼 수 있는 html 을 뽑는 스크립트를 자주 사용합니다. 웹 브라우저에서 이미지를 보게 되면 파일이 많아도 화면 이동 속도가 거의 느려지지 않고 이미지와 함께 전달하게 되면 사용자가 간단하게 이미지 리스트를 확인 할 수 있기 때문입니다. 또한 이미지 수정 시 별도로 엑셀등을 수정하지 않고 저장된 이미지만 교체하면 바로 수정된 결과를 볼수 있는 장점도 있기 때문입니다.

사용하시는 분마다 용도는 다르겠지만 텍스트를 추출하는 기능만으로도 아주 커다란 효과를 낼 수 있을지 모릅니다.

 

자 그럼 오늘은 이만~

2019/07/12 - [DEV/VBA] - [vba] 자동화를 위하여 엑셀의 영역 설정하는 방법

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

2019/07/12 - [DEV/VBA] - [vba] For 구문 이용하기와 offset 사용 해 보기

2019/09/20 - [DEV/VBA] - [VBA] 엑셀에 그림 자동으로 넣기

반응형
반응형

정말 지긋지긋한 마이크로 소프트 입니다. 저는 VBA 를 하면서 이번 포스트 내용만큼 어의가 없는 경우는 없었던거 같습니다. 왜 때문이냐고요? 바로 아주 단순한 셀 넓이를 VBA 를 이용하여 지정하는 방법 때문입니다.

자 제가 왜 이런 반응을 보이는가 하면요.

엑셀 VBA 에서 셀의 넓이 즉 range.columnWidth 를 지정할때 정말 독특한 단위와 방법을 사용하기 때문입니다.

일단 셀의 넓이는 다음의 두가지 방법으로 구할 수 있습니다. 그런데 그 두가지가 반환하는 값의 정체를 보면 정말 당황스럽기 짝이 없죠.

Range.Width [읽기]
 : 셀의 넓이를 point 로 반환한다. 

Range.ColumnWidth [읽기/쓰기]
 : (나름데로 해석한 결과)셀의 넓이를 현재 지정된 폰트의 "Normal" 인 상태를 기준으로 하는 글자 하나의 크기를 1로 하고 마진값을 추가한 값을 설정 또는 반환한다.

 

 

????????????

 

 

저게 뭔가요.. 

물론 글자가 짤리 않도록 셀의 폭을 지정하는 기능 아주 좋습니다. 글자수만 알면 되는거죠. 훌륭합니다. 네.

그런데 왜 Width 는 읽기 만 가능하며 point 나 pixel 같은 값으로는 설정이 안되는 것인가요? 저와 같은 그래픽 디자이너는 이미지를 붙이든 뭘해도 pixel 을 기준으로 값을 정의하는게 일상인데요. 뜬금없이 왠 글자의 크기를 이용하여 margin 까지 덧붙여 크기가 지정되는 걸까요? 게다가 현재 지정된 폰트의 Normal 상태 일때 라니... 만약 글자 크기가 달라지거나 스타일이 달라지면 같은 값을 지정해도 폭이 달라질 수 있다는 이야기가 됩니다.

 

해외 사이트들을 구글링 해보았으나 마땅한 답이 없더군요. 

그래서 그냥 코드를 짜 보았습니다.

VBA function : Pixel to ColumnWidth

Sub setColumnWidth(ByVal mRng As Range, ByVal targetWidth_pixel As Integer)

    'point = pixel * 0.75'
    'pixel = point / 0.75'
    'columnWidth = char Width + margin(fixed)'
    
    Dim cWidth_A As Double
    Dim cWidth_B As Double
    Dim cWidth_margin As Double
    Dim columnWidthRatio As Double
    Dim testColumnWidth As Double
    
    Dim cWidth As Double
    
    testColumnWidth = 10
    
    
    ' 가로 크기 지정시 발생되는 margin 을 알아보기 위하여 1배, 2배 크기일때 유지되는 margin 을 구해보자'
    mRng.ColumnWidth = testColumnWidth
    cWidth_A = mRng.Width   '(point)'
    
    mRng.ColumnWidth = testColumnWidth * 2
    cWidth_B = mRng.Width   '(point)'
    
    ' 항상 고정으로 유지되는 margin 크기 확인 (point)'
    cWidth_margin = cWidth_B - ((cWidth_B - cWidth_A) * 2)
        
    'point 값이 columnWidth 로 변환되기 위한 ratio 를 구한다. 이때 전체 넓이에서 위에서 구한 margin 을 생략하고 계산한다. '
    'columnWidthRatio : point --> columnWidth'
    columnWidthRatio = mRng.ColumnWidth / (cWidth_B - cWidth_margin)
    
    '최종 크기 지정'
    mRng.ColumnWidth = (targetWidth_pixel - (cWidth_margin / 0.75)) * 0.75 * columnWidthRatio
        
        
End Sub

 

약간 복잡해 보이지만 함수 형태로 만들어 놓았으므로 코드를 가져다가 그냥 사용하시면 됩니다. 인자로 크기를 조정해야 하는 셀과 pixel 기준의 크기를 입력해 주시면 되고요. 아래와 같이 사용하시면 됩니다.

Sub test()
    Dim rngA As Range    
    Set rngA = [d3]
    
    setColumnWidth rngA, 256
End Sub

 

이렇게 하면 D3 에 해당하는 column 의 폭이 256 pixel 로 설정이 됩니다.

 

코드를 좀 보시는 분은 금방 아시겠지만 원리는 다음과 같습니다.

columnWidth 는 고정된 단위가 아니므로 point 라는 단위를 이용하여 columnWidth 로 환산하기 위한 ratio 를 구해야 합니다. columnWidth / Width 하면 되는거죠. 그런데 여기에 함정이 있습니다. 

columnWidth 라는 값이 반환하는 값이 글자의 폭 + margin 이기 때문에 위와 같이 단순 계산을 하면 정확한 값으로 설정을 할 수가 없습니다. margin 만큼씩 계속 오차가 있는 것이지요. 그래서 margin 을 구하는 과정이 선행되었던 것입니다.

제가 몇번 테스트 해본 결과 글자을 속성을 중간에 바꾸지 않는다면 margin 의 값은 항상 일정한 것을 확인하였기 때문에 columnWidth 를 10 , 20 으로 두배 차이나게 각각 적용했을때의 Width 를 이용하여 변하지 않는 크기를 찾아내 해당 크기를 margin 으로 지정하였습니다.

결과적으로는 현재 구해진 Width(point) - margin(point) 로 ColumnWidth 를 나누어 주게 되면 point 값을 columnWidth로 환산 하기 위한 비율이 구해지게 되는 것이죠.

끝으로 입력된 픽셀에서 margin 에 해당되는 픽셀 크기를 빼 준뒤 point 로 전환한 다음 위에서 구한 비율을 곱해주게 되면 정확하게 pixel 에 대응되는 columnWidth 를 구할 수 있게 됩니다.

 

정말 저는 미국인들이 inch 를 사용하는 이유도 모르겠고 microSoft 사에서 위와 같이 독특한 단위만 입력하도록 개발해놓은 이유도 알 수가 없습니다. 

이번 기회로 저역시 좋은 공부가 되었기에 포스트로 남깁니다.

도움이 되셨거나 본 포스트가 괜찮으셨으면 공감 부탁드립니다~

 

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

 

[vba] 셀 속성 조정하기 (넓이, 높이, 숨기기, 테두리 등)

이번 포스트에서는 vba 를 이용하여 셀의 속성을 조정하는 방법을 설명 드리겠습니다. 엑셀은 단순한 표의 형식을 취하고 있지만 셀의 간격이나 테두리 등의 속성을 자유롭게 조정할 수 있어 다양한 서식에 사용하..

diy-dev-design.tistory.com

2019/09/20 - [DEV/VBA] - [VBA] 엑셀에 그림 자동으로 넣기

 

[VBA] 엑셀에 그림 자동으로 넣기

안녕하세요. 이번 강좌에서는 엑셀 시트에 있는 이미지 파일 경로를 이용하여 셀에 이미지를 붙여넣는 스크립트를 한번 알아 보겠습니다. 엑셀에 이미지를 몇장 붙여 넣는 거야 그림 삽입하기로 손쉽게 넣으면 되..

diy-dev-design.tistory.com

2019/08/30 - [DEV/VBA] - [VBA]RGB 색상 값이 들어있는 셀에 셀 색상 지정하기

 

[VBA]RGB 색상 값이 들어있는 셀에 셀 색상 지정하기

이번 강좌에서는 셀에 입력되어 있는 컬러 값을 이용하여 셀의 색상을 지정하는 방법을 알아보도록 하겠습니다. 디자이너 분들이라면 언제가 한번쯤은 엑셀 시트에 자신이 정의한 컬러 값을 정리해서 보내야 하는..

diy-dev-design.tistory.com

2022.12.02 - [DEV/VBA] - [excel vba] 16진수를 10진수로, 10진수를 16진수로 변경

 

[excel vba] 16진수를 10진수로, 10진수를 16진수로 변경

오늘은 간단한 VBA 코드를 하나 소개해 드릴까 합니다. 프로그래밍을 하다보면 16진수를 10진수로 바꾸거나 10진수를 16진수로 바꾸어야 하는 경우가 종종 있습니다. 읭? 16 진수? 라고 하실수도 있

diy-dev-design.tistory.com

 

 

반응형

+ Recent posts