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

오늘은 간단한 VBA 코드를 하나 소개해 드릴까 합니다.

프로그래밍을 하다보면 16진수를 10진수로 바꾸거나 10진수를 16진수로 바꾸어야 하는 경우가 종종 있습니다.

읭? 16 진수?

라고 하실수도 있겠지만 막상 개발을 하다 보면 16진수가 쓰이는 경우를 생각보다 자주 만나게 됩니다. 

대표적을 RGB 컬러 값을 HTML 에서 사용하는 #FFEACB 이런 값으로 변경하는 작업이 있겠습니다. 또는 반대로 0 ~ FF 가지 255개의 숫자가 16진수로 구성되어 있는 값을 0~255인 자연수로 변경을 해야 하는 경우가 있을 수도 있고요. 16진수는 1개의 자릿수에서 0~15 까지의 값을 표현할 수 있기 때문에 10진수에 비하여 간단한 텍스트로 더 큰 숫자를 표현할 수 있다는 장점도 있습니다.

자 쓸데 없는 말이 길었네요.

VBA를 이용해서 숫자의 형을 변환하는 여러가지 방법이 있지만 오늘 소개해드릴 방법은 그중에서도 단연 쉽고 간단한 방법입니다.

바로 worksheet의 함수를 이용하는 방법인데요. 엑셀 상단에 수식을 입력할 수 있는 칸이 있자나요? 여기서 사용되는 함수가 바로 worksheet function 입니다. 

worksheet function 중에 DEC2HEX() 와 HEX2DEC()  가 바로 오늘의 주인공 입니다.

함수 명칭만 봐도 딱 감이 오시죠?

사용하는 방법은 아래와 같습니다.

먼저 위와 같이 엑셀에 16진수 값이 들어있는 셀이 있다고 가정을 하고요.

vba 에디터를 열어 아래와 같이 코드를 작성해봅니다.

Sub changeNumber()

    Dim rngA As Range
    Set rngA = [A1]
    
    rngA.Offset(0, 1).Value = WorksheetFunction.Hex2Dec(rngA.Value)
    rngA.Offset(0, 2).Value = WorksheetFunction.Dec2Hex(rngA.Offset(0, 1).Value)

End Sub

자 A1 셀에 있는 값을 바로 우측 옆 칸에 10진수로 바꾸는 함수를 적용하여 값을 넣어 줍니다.

그다음 B1 에 위에서 자동으로 입력된 값을 다시 16진수로 옆칸에 자동으로 입력해주는 코드 입니다.

실행하면요

요렇게 B1 에는 10진수로, 다시 C1 에는 16진수로 값이 변경된 것을 볼 수 있죠?

worksheetFunction 에는 물론 엑셀에서 사용할 수 있는 모든 함수를 지원해 주니까 vba 작성중에도 가져다가 사용할 만한 함수가 많지만 오늘 포스트의 주제에 맞게 숫자의 형 변환 관점에서만 보자면 아래와 같은 여러 함수들이 지원됩니다.

물론 Hex 로 부터 출발 하는 경우에도 마찬가지 입니다.

문장이 조금 길어 보여서 어렵거나 복잡하게 생각될 수도 있기는한데 막상 사용해보면 생각보다 단순 합니다. 사용하는데 따로 알아두어야 할 규칙 같은것도 없어서 코딩하는 시간도 많이 절약되는 방식이라 할 수 있겠습니다.

만약 아래와 같이 셀에 html 색상 값이 들어있는 경우 

vba를 이용하여 해당 색상으로 셀의 배경 색상을 자동으로 칠해 줄 수 있습니다.

Sub changeNumber()

    Dim rngA As Range
    Set rngA = [A1]
    
    Dim clrR As Integer
    Dim clrG As Integer
    Dim clrB As Integer
    
    clrR = WorksheetFunction.Hex2Dec(Mid(rngA.Value, 2, 2))
    clrG = WorksheetFunction.Hex2Dec(Mid(rngA.Value, 4, 2))
    clrB = WorksheetFunction.Hex2Dec(Mid(rngA.Value, 6, 2))
    
    rngA.Interior.Color = RGB(clrR, clrG, clrB)
    

End Sub

간단하죠? 위에서 소개해 드린 worksheetFunction을 이용하여 2자리씩 잘라낸 16진수를 10진수로 담은뒤에 셀의 배경 색상으로 지정하는 것이죠.

글자를 잘라내는 건 2019.08.12 - [DEV/VBA] - [VBA] 문자열 가지고 놀기 참고하세요~

스크립트를 실행하면 어떻게 될까요?

요렇게 html 형식의 색상 값으로 셀의 색상이 지정 됩니다.

뭐 한두칸이야 얼마든지 수작업으로도 적용할수 있기는 합니다만 이런 값이 수천개가 있는데 모두 엑셀 시트에서 지정된 색상으로 보여지기를 원한다면 vba 가 반드시 필요하겠죠?

그럼 이만 오늘의 포스팅을 마칩니다.

2022.06.16 - [DEV/VBA] - [VBA] 선택한 셀의 이미지 파일 이미지 뷰어로 열기

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

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

2019.08.12 - [DEV/VBA] - [VBA] 문자열 가지고 놀기

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

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

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

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

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

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

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

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

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

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

그럼 선택한 셀 정보를 얻어오는 스크립트가 필요하겠고 윈도우 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#] - 재택근무 필수 유틸 "자리안비움" - 윈도우 꺼짐 방지

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

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

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

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

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

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

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

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

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

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

'ㅎㅎ

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

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

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

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

20200901 내용 추가

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

20230512 내용 추가

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

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

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

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

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

그럼 이만~

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 를 조금 이해하시는 분이라면 직접 수정하여 사용하시는 것도 가능합니다.

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

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

그리고...

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

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

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

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

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

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

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

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

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

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

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

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

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

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

가끔 모니터 가로세로 크기가 궁금할 때가 있습니다. 휴대폰 구입 전 화면 크기를 정확히 알고 싶은 경우도 있지요.

그런데 이상하게 화면의 가로세로 크기에 대하여 mm 로 설명이 나오지 않는 경우가 많죠. 책상과 모니터를 새로 사기 위하여 크기가 궁금하다면 그런데 어디에도 정보가 없다면 모니터를 구입하여 자로 재는 수밖에 없습니다. -_-;;

픽셀 피치라던가 DPI, 몇인치 인지, 가로세로 최대 해상도 뭐 이런 정보들은 많은데요 막상 실제 모니터 LCD 의 가로, 세로의 길이를 mm 나 cm 로 알려주는 곳은 많지 않죠.

이런 분들을 위해 엑셀로 간단하게 계산 하는 수식을 하나 올려드리겠습니다. 

아래와 같이 셀의 정보를 설정합니다.

B4 : 인치 수 입력 (ex. 21)
E4 : 가로 해상도 입력 (1920)
F4 : 세로 해상도 입력 (1080)

가로크기 mm (아래 수식을 원하는 가로 길이 셀에 넣으세요)
= 25.4*(B4*E4)/SQRT((E4*E4)+(F4*F4))

세로크기 mm (아래 수식을 원하는 세로 길이 셀에 넣으세요)
= 25.4*(B4*F4)/SQRT((E4*E4)+(F4*F4))

저는 C4, D4 셀에 구하고자 하는 위치를 정한뒤 위의 수식을 넣었습니다.

1920 1080 해상도의 24 인치 모니터의 LCD 크기는 아래와 같습니다. 

회색칸으로 표시된 곳에 크기가 잘 나왔죠? 

흰색 칸에 위에 말씀드린 정보만 입력하면 가로 세로 크기를 정확하게 보여줍니다.

VBA 가 아닌 엑셀 함수이므로 값을 입력하는 즉시 크기를 알 수 있습니다.

휴대폰의 액정크기를 확인하는데 사용하셔도 됩니다.

해상도와 인치수만 안다면 어떤 LCD에도 다 적용되니 커스텀 LCD 모니터 제작이나 뭐 다른 궁금한 곳에 사용해도 다 됩니다.

유용하게 사용하시기 바랍니다~ ^^

2020/04/03 - [DIY] - LEGO 블럭을 이용한 전자담배 기기 직접 제작하기

2020/05/17 - [DIY] - [재활용] 고장난 LED 바 수리하기 > 화장대 조명 만들기

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

오늘 포스트에서는 지난 엑셀 자동화 툴의 뎃글로 문의 주신 헤더에 이미지를 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, 엑셀 자동화 프로그램