선택한 셀에 이미지 파일명을 아래와 같이 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) 과 같은 방법으로 연결하였지만 별도 셀에 이미지 경로가 들어있다면 해당 경로를 따로 지정해 주거나 스크립트 내에 문자열로 넣어 주셔도 되겠습니다.
이렇게 만들어진 매크로를 버튼에 연결하는 방법은
버튼을 최초 생성할때도 보였겠지만 매크로를 연결하는 메뉴가 있습니다. 단추에서 오른쪽 클릭한 다음 "매크로지정" 을 선택하면 매크로 선택창이 나타나게 되는데요, 여기서 지금 만들어준 스크립트를 선택해주면 됩니다.
자 이제 어떻게 동작하는지 한번 볼까요?
먼저 이미지 들이 들어있는 폴더가 있을 거고요. 만약 이미지가 아닌 셀을 선택하면 경고창을, 이미지 이름을 선택하면 윈도우 이미지 뷰어로 바로 열리게 됩니다.
자 간단하게 원하는 기능이 구현되었습니다.
필요하신 분들은 소스 복사하셔서 사용하시면 될 것 같고요. 잘 응용하셔서 본인의 엑셀 문서에 딱 맞는 기능으로 추가하시면 되겠습니다..
예를 들면 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
이렇게 하면 다른시트에서 비교한뒤 동인한 명칭을 갖는 행의 값을 가져오면서 가져온 개수를 알 수 있습니다.
엑셀 파일을 이용하여 정말 다양한 작업이 가능합니다. 계산이며 표만들기며 각종 정보를 분석하거나 데이터 화 시키는 작업 등 정말 할 수 있는 일이 무궁무진 하죠. 그런데 가끔 엑셀을 이용하여 특정 정보를 별도로 텍스트 등으로 저장해야 하는 경우가 있습니다. 개발 쪽에서 어떤 데이터 리스트를 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 을 뽑는 스크립트를 자주 사용합니다. 웹 브라우저에서 이미지를 보게 되면 파일이 많아도 화면 이동 속도가 거의 느려지지 않고 이미지와 함께 전달하게 되면 사용자가 간단하게 이미지 리스트를 확인 할 수 있기 때문입니다. 또한 이미지 수정 시 별도로 엑셀등을 수정하지 않고 저장된 이미지만 교체하면 바로 수정된 결과를 볼수 있는 장점도 있기 때문입니다.
사용하시는 분마다 용도는 다르겠지만 텍스트를 추출하는 기능만으로도 아주 커다란 효과를 낼 수 있을지 모릅니다.
엑셀은 단순한 표의 형식을 취하고 있지만 셀의 간격이나 테두리 등의 속성을 자유롭게 조정할 수 있어 다양한 서식에 사용하기 적합한 훌륭한 워드 프로세서 입니다.
데이터의 타입이나 종류에 따라 현재 엑셀 시트의 표를 자동으로 설정해주는 것이 필요한 경우가 있습니다.
예를 들면 csv 로 내려받은 단순한 정보들을 시트에 올리고 필요한 정보와 필요하지 않은 정보의 열을 구분하여 표시해 준다던가 아예 불필요한 열이나 행은 숨김 처리를 할 수도 있고요. 주요 행의 테두리 정보를 구분하여 보여주어야 하는 경우도 있겠습니다. 또한 서실을 vba로 만들어 놓으면 어떤 다른 인원에 의해 조정된 폼을 원래 지정한 형식으로 완벽하고 빠르게 설정하는 것도 가능할 것입니다.
이번 포스트에서는 아래의 내용을 다루려고 합니다.
행의 높이를 조절하는 방법
열의 넓이를 조정하는 방법
행 또는 열을 숨기거나 숨김 취소 하는 방법
테두리 선을 지정하는 방법
테두리 선의 모양을 지정하는 방법
엑셀 VBA 를 이용하여 행(row) 높이를 지정하는 방법
Sub changeCellStyle()
Dim mySht As Worksheet
Dim myCell As Range
Set mySht = ActiveSheet
Set myCell = mySht.Range("B2") ' 원하는 행의 셀을 지정
' 지정한 셀(행)의 높이를 32로 설정한다.
myCell.RowHeight = 32
'픽셀 기준으로 입력하고 싶다면 0.75 를 곱하세요.
myCell.RowHeight = 32 * 0.75
End Sub
행의 높이를 Pixel 을 기준으로 지정해야 하는 경우 pixel size * 0.75 를 해주면 됩니다.
예를 들면 이미지를 붙여넣는 등의 작업을 할때 이미지의 크기가 150 이라면 150 * 0.75 의 값을 셀의 크기에 지정을 하면 됩니다. 아래와 같이 말이죠.
엑셀 VBA 를 이용하여 열(column)의 넓이를 지정하는 방법???
여기서 셀의 폭을 지정하는 방법은 갑자기 이야기가 달라집니다. 저는 그래픽 디자이너 이므로 당연히 픽셀 기준으로 셀의 넓이를 정해주고 싶거든요. 여기서 미치고 팔딱 뛰는 상황이 생겨나게 됩니다.
Sub changeCellStyle()
Dim mySht As Worksheet
Dim myCell As Range
Set mySht = ActiveSheet
Set myCell = mySht.Range("B2") ' 원하는 행의 셀을 지정'
' 선택한 셀이 있는 모든 행을 숨김처리할 때'
myCell.EntireRow.Hidden = True
' 선택한 셀이 있는 모든 행을 숨김취소 할때'
myCell.EntireRow.Hidden = False
End Sub
숨기거나 해제 하는 것은 간단하죠?
entireRow 라는 개체를 이용하여 전체 행에 대한 지정을 한뒤 hidden 이라는 프라퍼티로 숨기거나 숨기지 않도록 설정 할 수 있습니다.
Sub changeCellStyle()
Dim mySht As Worksheet
Dim myCell As Range
Set mySht = ActiveSheet
Set myCell = mySht.Range("B2") ' 원하는 행의 셀을 지정
' 선택한 셀의 테두리를 없애는 방법 '
myCell.Borders.LineStyle = xlNone
'선택한 행전체의 테두리를 없애는 방법
myCell.EntireRow.Borders.LineStyle = xlNone
End Sub
선택한 셀의 테두리를 지정하는 방법
Sub changeCellStyle()
Dim mySht As Worksheet
Dim myCell As Range
Set mySht = ActiveSheet
Set myCell = mySht.Range("B2") ' 원하는 행의 셀을 지정
'선택한 행전체의 테두리를 없애는 방법
myCell.EntireRow.Borders.LineStyle = xlNone
' 선택한 셀의 왼쪽 테두리만 보통의 실선으로 보여주는 방법 '
myCell.Borders(xlEdgeLeft).LineStyle = xlContinuous
' 선택한 셀의 오른쪽 테두리만 보통의 실선으로 보여주는 방법 '
myCell.Borders(xlEdgeRight).LineStyle = xlContinuous
' 선택한 셀의 위쪽 테두리만 보통의 실선으로 보여주는 방법 '
myCell.Borders(xlEdgeTop).LineStyle = xlContinuous
' 선택한 셀의 아래쪽 테두리만 보통의 실선으로 보여주는 방법 '
myCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
' 선택한 셀의 테두리를 보통의 실선으로 보여주는 방법 '
myCell.Borders.LineStyle = xlContinuous
End Sub
제가 방향별로 지정하는 방법을 적어 두었으니 필요한 내용을 추려다가 사용하시면 됩니다.
테두리의 선의 속성을 변경하는 하는 방법
만약 아래쪽 선만 두껍게 지정하고 싶다면?
' 선택한 셀의 아래쪽 테두리만 두꺼운 실선으로 보여주는 방법 '
myCell.Borders(xlEdgeBottom).Weight = xlThick
myCell.Borders(xlEdgeBottom).LineStyle = xlContinuous
요렇게 해주시면 됩니다.
참고로 라인 스타일을 xlContinuous 말고 점선이나 다양한 스타일로 적용하는 것도 가능합니다.
xlContinuous 연속선입니다.
xlDash 파선입니다.
xlDashDot 교대로 연결된 파선과 점선입니다.
xlDashDotDot 파선과 두 개의 점선입니다.
xlDot 점선입니다.
xlDouble 이중선입니다.
xlLineStyleNone 선이 없습니다.
xlSlantDashDot 기울어진 파선입니다.
위에 소개해드린 여러가지 속성들을 조합하면 하나의 완성된 폼을 자동으로 생성하는 것이 가능합니다.
한번 짜 놓을 때는 귀찮을 수 있지만 수도없이 계속해서 폼을 맞추어주어야 하는 어떤 상황이라면 자동화 개발을 하는것이 정신건강이나 육체건강에 좋겠죠.
일을 하다 보면 가끔 업무를 진행하던 경로 하위에 있는 데이들의 리스트를 만들어야 하는 경우가 있습니다. 하나의 폴더라면 어떻게 해보겠는데 그 폴더가 하위 뎁스가 연속해서 있고 저장되어 있는 파일이 불특정으로 다수 있는 경우 이를 리스트로 만드는 일은 정말 끔찍한 일이 아닐 수 없습니다.
이런 경우 손쉽게 리스트로 작성하는 스크립트를 만들어 보았습니다.
폴더 및 하위 폴더의 파일 명칭은 물론 저장된 경로, 파일의 만든날짜, 수정한 날짜 등의 속성을 표시할 수 있도록 하고 파일의 용량과 타입까지 자동으로 리스트로 만들어 보려 합니다.
이러한 코드를 작성하기 위하여 개발을 할 내용을 준비해봅니다.
엑셀 vba 에서 사용 가능한 File 및 Directory 관련 개체를 알아보자.
지정한 폴더내에 파일이 있는 경우 파일의 이름과 속성등을 가져와 기록해주자
파일이 바뀔때마다 줄을 바꾸어 주자
폴더를 만나게 되면 해당 폴더 하위의 파일을 찾아주자.
2 ~ 4 번은 하위 폴더를 만날때 마다 계속해서 반복해주어야 하므로 재귀 함수로 동작하도록 구성하자. * 재귀함수란 자신이 자신을 호출하는 함수를 말합니다.
연속해서 위치를 이동시켜야 하므로 range.offset(y,x) 를 이용하되 x, y 는 전역 변수 (public)로 설정해주자
요 정도면 원하던 기능의 구현이 가능할 것 같습니다.
제가 작성한 코드를 아래에 올려보겠습니다.
보시면서 위에 설명드린 동작이 어떤 과정으로 일어나는지 확인해 보세요.
Public fso As Object
Public offsetY As Integer
Public offsetX As Integer
Public stRng As Range
Sub getSubFileList()
Dim fsoFolder As Object
Dim aSht As Worksheet
Dim rootpath As String
rootpath = "C:\Users\mariine\Pictures\excel_test\"
offsetX = 0
offsetY = 0
Set aSht = ActiveSheet
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoFolder = fso.GetFolder(rootpath)
Set stRng = aSht.Range("B2")
getDataRecursive fsoFolder
End Sub
Sub getDataRecursive(ByVal baseFolder As Object)
Dim tmpSubFolders As Object
Dim tmpFiles As Object
Dim tmpRng As Range
offsetX = offsetX + 1
Set tmpSubFolders = baseFolder.subFolders
Set tmpFiles = baseFolder.Files
For Each c In tmpFiles
stRng.Offset(offsetY, offsetX).Value = c.Name ''파일명
stRng.Offset(offsetY, offsetX - 2).Value = offsetY + 1 ''인덱스
stRng.Offset(offsetY, offsetX - 1).Value = c.ParentFolder.Path ''경로명
stRng.Offset(offsetY, offsetX + 1).Value = c.Size / 1000# & "kb" ''파일용량
stRng.Offset(offsetY, offsetX + 2).Value = c.DateCreated ''만든날짜
stRng.Offset(offsetY, offsetX + 3).Value = c.DateLastModified ''수정한날짜
stRng.Offset(offsetY, offsetX + 4).Value = c.Type ''파일타입
offsetY = offsetY + 1
Next c
offsetX = offsetX - 1
For Each d In tmpSubFolders
Dim tmpSub As Object
Set tmpSubs = fso.GetFolder(d)
getDataRecursive tmpSubs
Next d
End Sub
제일 상단의 4줄은 이번 코드에서 사용할 전역 변수를 설정해주는 모습입니다.
전역변수를 설정해주면 하위의 어떤 함수에서건 해당 값을 읽고 쓸 수 있게 됩니다. A 함수에서 변경한 전역 변수의 값을 B 함수에서도 그대로 사용이 가능하게 됩니다.
그 다음 만나는 Sub getSubFileList() 함수가 동작을 설정하는 함수가 되겠고요. FileSystemObject 라는 파일 및 디렉토리 작업이 가능한 COM 오브젝트를 선언하여 서브폴더나 폴더, 파일 등에 접근이 가능하도록 하고 있습니다.
그리고 그뒤로 이어지는 재귀 함수인 Sub getDataRecursive(ByVal baseFolder As Object) 를 호출하는 것으로 동작이 시작됩니다.
그렇게 시작된 재귀함수는 입력받은 폴더내에 파일이 있으면 파일의 이름 및 기타 속성들을 줄을 바꾸어 가며 기록을 진행하고 모든 파일에 대하여 기록이 끝나면 그아래 해당 폴더에 하위 폴더가 있는지 검사한뒤 하위 폴더가 있는 경우 또다시 자신 (폴더내의 파일을 찾아 기록하는 함수) 을 호출하여 주게 되는 겁니다.
이렇게 해주면 하나의 재귀함수로 아무리 깊고 많은 뎁스의 폴더안의 파일들도 모두 탐색이 가능해 지게 되겠습니다.
이렇게 만들어진 리스트는 아래와 같습니다.
만약 특정 확장자만 검색하고 싶으시면 실제 파일 속성을 기록하는 For 구문의 바로 첫 행에 IF 문을 이용하여 파일 이름내에 필요한 확장자가 있는지 검사를 진행하면 되겠습니다.
예를 들어 xlsx 파일만 리스트로 만들고 싶다면 해당 For 구문을 아래와 같이 변경하면 되겠습니다.
For Each c In tmpFiles
If InStr(c.Name, ".xlsx") Then
stRng.Offset(offsetY, offsetX).Value = c.Name '파일명
stRng.Offset(offsetY, offsetX - 2).Value = offsetY + 1 '인덱스
stRng.Offset(offsetY, offsetX - 1).Value = c.ParentFolder.Path '경로명
stRng.Offset(offsetY, offsetX + 1).Value = c.Size / 1000# & "kb" '파일용량
stRng.Offset(offsetY, offsetX + 2).Value = c.DateCreated '만든날짜
stRng.Offset(offsetY, offsetX + 3).Value = c.DateLastModified '수정한날짜
stRng.Offset(offsetY, offsetX + 4).Value = c.Type '파일타입
offsetY = offsetY + 1
End If
Next c
어렵지 않죠?
만약 있어서는 안되는 확장자가 들어있다면 눈에 띄게 표시를 하는것도 어렵지 않습니다.
예를 들어 폴더내에 hwp 파일만 있어야 한다고 했을때 해당 폴더에 .doc 파일처럼 또 다른 있는 경우 빨간색으로 셀을 표시할 수 있습니다.
For Each c In tmpFiles
stRng.Offset(offsetY, offsetX).Value = c.Name '파일명
stRng.Offset(offsetY, offsetX - 2).Value = offsetY + 1 '인덱스
stRng.Offset(offsetY, offsetX - 1).Value = c.ParentFolder.Path '경로명
stRng.Offset(offsetY, offsetX + 1).Value = c.Size / 1000# & "kb" '파일용량
stRng.Offset(offsetY, offsetX + 2).Value = c.DateCreated '만든날짜
stRng.Offset(offsetY, offsetX + 3).Value = c.DateLastModified '수정한날짜
stRng.Offset(offsetY, offsetX + 4).Value = c.Type '파일타입
If Not InStr(c.Name, ".hwp") Then
stRng.Offset(offsetY, offsetX).Interior.Color = RGB(255, 0, 0)
End If
offsetY = offsetY + 1
Next c
참 쉽죠?
이렇게 해서 폴더내의 모든 파일을 하위폴더를 포함하여 가져오는 스크립트를 알아보았습니다. 이런식의 작업은 엑셀의 워크시트 함수만을 이용하여 작업하기는 어렵기 때문에 vba를 좀 할줄 알면 아주 많은 시간을 절약하는 것이 가능합니다.
오늘은 여기까지 하도록 하겠습니다.
관련하여 사전 지식이 부족하신 분은 아래 관련 포스트를 링크해 드리니 참고하시면 되겠습니다.
안녕하세요. 이번 강좌에서는 엑셀 시트에 있는 이미지 파일 경로를 이용하여 셀에 이미지를 붙여넣는 스크립트를 한번 알아 보겠습니다. 엑셀에 이미지를 몇장 붙여 넣는 거야 그림 삽입하기로 손쉽게 넣으면 되지만 붙여넣어야 할 그림이 몇백개 이상이 되면 답이 나오지 않는 상황이 옵니다. 절망 적이죠. 바로 야근 각입니다.
하지만 스크립트가 출동한다면 ?
칼퇴근 쌉가능
게다가 셀의 크기에 맞게 가지런히 딱 붙여줄수 있다면 말할 필요도 없이 선배님에게 쓰담쓰담 각 입니다.
어렵지 않으니 천천히 따라와 주시면 됩니다.
*** 개발에 관심 1g도 없고 그림만 자동으로 붙여 넣고 싶으시다면 아래 포스트를 참고해주세요
저는 아래의 방법을 선호 합니다. 위의 방법은 코드가 짧고 단순하여 작성이 편리하기는 하지만 엑셀 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 처럼 말이죠.
어디 메모장이나 노트에 붙여 넣어 두셨다가 필요하실 때 사용하시면 됩니다.
이상으로 이미지를 한번에 붙여 넣는 자동스크립트를 알아 보았습니다.
뎃글,공감은 블로그 작성자에게 큰 힘이 된답니다. 도움이 되었다 생각되시면클릭!! 부탁드려요~
요이번 강좌는 에셀 시트의 모든 셀의 색상을 한번에 제거하는 방법을 알려 들리려고 합니다. 강좌라고 할것도 없을 만큼 간단한 스크립트인데요. select all 한다음 셀 색상을 빼내도 되긴 하겠지만 자동화 과정 중에 셀 색상을 초기화 해야 하는 경우가 있다면 아래의 스크립트를 이용하여 모두 초기화 시킨 후 자동화 과정을 수행할 수 있습니다.
Sub crearCellColor()
Cells.Interior.Color = xlNone
End Sub
간단하죠?
이렇게 특정 시트에 대한 지정없이 사용하는 것은 특정 시트에 바로 스크립트를 작성하는 경우인데요. ThisWorkBook 과 같은 공용 위치에서 스크립트를 작성할 때는 색상을 초기화 해줄 시트를 지정해 주어야 합니다.
Sub crearCellColor()
Dim aSht As Worksheet
Set aSht = ActiveSheet
aSht.Cells.Interior.Color = xlNone
End Sub
요렇게 상단에 worksheet 개체를 정의 하여 주고 해당 시트가 현재 활성화 되어 있는 시트임을 알려준뒤 해당 시트에서 실행을 하면 됩니다.
선택된 영역 또는 특정영역에 컬러는 채워넣을 때는 RGB(255,255,255) 와 같은 함수를 이용합니다. 만약 셀에 노란색을 채워 넣으려면 아래와 같이 하면 됩니다.
이번 강좌에서는 셀에 입력되어 있는 컬러 값을 이용하여 셀의 색상을 지정하는 방법을 알아보도록 하겠습니다. 디자이너 분들이라면 언제가 한번쯤은 엑셀 시트에 자신이 정의한 컬러 값을 정리해서 보내야 하는 경우가 생길 수 있게 마련입니다. 요구사항을 내는 담당자는 포토샵이나 일러스트 보다는 엑셀이 더 익숙하기 때문에 엑셀로 정의되어 있는 컬러값을 전달 받기를 원하게 마련입니다. 물론 우리는 스마트하게 컬러까지 딱 채워서 보내주면 담당자가 아주 흡족해 하겠죠.
먼저 셀에 컬러를 표현할 수 있는 RGB 에 대한 색상이 저장되어 있다는 가정하에 코드를 작성할 예정입니다. 셀에 입력되어 있는 값이 여러가지 경우가 있을 수 있기 때문에 오늘은 그 여러가지 경우의 컬러를 지정하는 방법을 알아볼 예정입니다.
먼저 셀의 색상을 지정하는 코드는 아래와 같습니다.
Cells(1,1).Interior.Color = RGB(255,255,255)
여기서 Cells(1,1) 부분은 For each c 라는 식의 반복문에서 c 로 변경하여 적용하면 됩니다.
오늘 알아볼 색상 적용 방법은 다음과 같습니다.
6자리 HEX 코드로 입력된 셀에 색상을 입히는 방법
HEX값이 R,G,B 로 각각 나뉘어 기록되어 있는 경우 색을 칠하는 방법
RGB 값이 각각 셀에 지정되어 있을 때 색을 칠하는 방법
RGB 값이 하나의 셀에 특정한 구분자를 이용하여 적용되어 있을 때 색을 칠하는 방법
6자리 HEX 코드로 입력된 셀에 색상을 입히는 방법
먼제 셀에 아래와 같은 형식으로 입력이 되어 있다고 가정하고 코드를 작성해 보겠습니다.
색상 코드에 # 가 붙어있는 녀석도 있고 없는 녀석도 있군요
이런 경우라면 약간의 판단 코드가 추가되어야 하겠습니다.
아래 코드를 보시죠.
Sub setColor()
Dim rngA As Range
Dim c As Range
Dim cur_value As String
Dim c_red As String
Dim c_green As String
Dim c_blue As String
Set rngA = [A1:A10]
For Each c In rngA
'첫글자가 # 이라면 #을 빼내주는 코드
If InStr(c.Value, "#") Then
cur_value = Mid(c.Value, 2, Len(c.Value) - 1)
Else
cur_value = c.Value
End If
' 6자리의 문자열에서 RGB 의 각각 색상으로 구분하여 주는 방법
c_red = Left(cur_value, 2)
c_green = Mid(cur_value, 3, 2)
c_blue = Right(cur_value, 2)
' RGB 로 나뉘어진 16진수 값을 0~255 의 자연수로 변경해주는 함수
c_red = WorksheetFunction.Hex2Dec(c_red)
c_green = WorksheetFunction.Hex2Dec(c_green)
c_blue = WorksheetFunction.Hex2Dec(c_blue)
c.Interior.Color = RGB(c_red, c_green, c_blue)
Next c
End Sub
실행시켜 보시면 요렇게 셀에 예쁘게 색상이 적용이 됩니다.
여기서 코드중에 WorksheetFunction.Hex2Dec(c_blue) 라는 코드가 있는데요. WorksheetFunction 이라 하면 엑셀 상단에 함수 작성하는 계산식 입력창이 있죠? 여기에 사용되는 함수가 바로 WorksheetFunction 인데요. 그 함수들 중에 Hex2Dec 라는 함수를 가져와서 쓰겠다는 것 입니다. 엑셀에는 이미 많은 훌륭한 함수 들이 있기 때문에 엑셀 vba 에서 그것들을 이용함으로써 빠르고 손쉽게 코딩이 가능하다는 장점이 있습니다.
HEX값이 R,G,B 로 각각 나뉘어 기록되어 있는 경우 색을 칠하는 방법
이번에는 아래와 같이 RGB 가 셀마다 정의되어 있는데 이 값이 Hex인 경우입니다.
위에서 작성한 코드가 거의 대부분 재활용될 예정이므로 어떤 부분이 변경이 되는지 잘 보시기 바랍니다.
Sub setColor()
Dim rngA As Range
Dim c As Range
Dim cur_value As String
Dim c_red As String
Dim c_green As String
Dim c_blue As String
Set rngA = [A1:A10]
For Each c In rngA
' c 를 기준으로 우측 첫번째, 두번째 칸의 값을 각각 변수에 적용
c_red = c.Value
c_green = c.Offset(0, 1).Value
c_blue = c.Offset(0, 2).Value
' RGB 로 나뉘어진 16진수 값을 0~255 의 자연수로 변경해주는 함수
c_red = WorksheetFunction.Hex2Dec(c_red)
c_green = WorksheetFunction.Hex2Dec(c_green)
c_blue = WorksheetFunction.Hex2Dec(c_blue)
c.Interior.Color = RGB(c_red, c_green, c_blue)
c.Offset(0, 1).Interior.Color = RGB(c_red, c_green, c_blue)
c.Offset(0, 2).Interior.Color = RGB(c_red, c_green, c_blue)
Next c
End Sub
이번에는 이미 값이 분리 되어 있으므로 c 라는 셀을 기준으로 우측 첫번째, 두번째 값을 RGB 변수에 저장하는 과정이 들어갔습니다.
별다를건 없죠?
RGB 값이 각각 셀에 지정되어 있을 때 색을 칠하는 방법
보통은 첫번째 케이스와 아래와 같은 케이스가 가장 많을 것 같습니다.
위의 두가지 케이스를 직접 해보셨다면 아래의 케이스는 이제 감이 잡이실것 같은데요.
네. 바로 Hex --> Dec 로 변경하는 코드는 여기에선 필요가 없습니다. 그냥 바로 셀에 적용하면 되겠죠?
Sub setColor()
Dim rngA As Range
Dim c As Range
Dim cur_value As String
Dim c_red As String
Dim c_green As String
Dim c_blue As String
Set rngA = [A1:A10]
For Each c In rngA
cur_value = c.Value
' 6자리의 문자열에서 RGB 의 각각 색상으로 구분하여 주는 방법
c_red = c.Value
c_green = c.Offset(0, 1).Value
c_blue = c.Offset(0, 2).Value
c.Interior.Color = RGB(c_red, c_green, c_blue)
c.Offset(0, 1).Interior.Color = RGB(c_red, c_green, c_blue)
c.Offset(0, 2).Interior.Color = RGB(c_red, c_green, c_blue)
Next c
End Sub
요렇게 적용하시면 됩니다. 적용 결과는?
네 .. 이렇게 잘 색칠이 되었네요.
RGB 값이 하나의 셀에 적용되어 있을 때 색을 칠하는 방법
네 마지막으로 RGB 값이 하나의 셀에 적용되어 있을때 입니다. 보통은 , 로 255,235,223 이런식으로 구분을 하여 넣어 주겠죠. 위에 LEFT, MID, RIGHT 와 같은 문자열의 위치를 이용하여 잘라내기가 쉽지 않습니다. 숫자가 1~3자리까지 다양하게 나올 수 있기 때문에 좀 다른 방법으로 글자를 떼어내볼 예정입니다.
여기서 사용할 함수는 Split 이라는 함수고요. 특정 글자를 이용하여 문자열을 배열로 잘라 나눠담아 주는 함수 입니다.
바로 엑셀에 이렇게 값이 들어있는 경우입니다.
Sub setColor()
Dim rngA As Range
Dim c As Range
Dim cur_value() As String
Dim c_red As String
Dim c_green As String
Dim c_blue As String
Set rngA = [A1:A10]
For Each c In rngA
cur_value = Split(c.Value, ",")
' 문자 배열에서 RGB 의 각각 색상으로 꺼내어 적용해주는 주는 방법
c_red = cur_value(0)
c_green = cur_value(1)
c_blue = cur_value(2)
c.Interior.Color = RGB(c_red, c_green, c_blue)
Next c
End Sub
코드를 보면 크게 달라진건 없는데요. 배열에 값을 담기위한 배열 변수를 선언해 주는 부분, Split 을 이용하여 문자열을 분리하는 작업, 배열의 값을 각 색상별 변수에 적용하는 과정이 약간 차이가 있습니다.
Dim cur_value as string --> 일반 적인 문자열 변수
Dim cur_value() as string --> 배열 형식의 문자열 변수
문자열을 배열에 담기 위하여는 위와 같은 배열 형의 문자열 변수를 선언해주어야 합니다.
이후 Split (자를 문자, 구분자) 를 이용하여 잘라 배열 변수에 담게 되면 잘라진 각각의 내용을 하나씩 꺼내어 사용할 수 있게 됩니다.
오늘은 엑셀 시트에 있는 모든 그림을 한번에 삭제하는 스크립트를 만들어 보겠습니다. 엑셀 시트에 첨부된 그림을 일일이 또는 어떤 조건에 맞는 모든 그림을 삭제 하는 것은 매우 귀찮은 일입니다. 일단 다중 선택을 위하여 하나하나 그림 개체를 선택해 주어야 하는데 대상을 잘못 클릭하거나 그 대상이 수백개 이상일 때는 정말 난처한 상황이 발생되죠.
그래서 이번에는 엑셀 시트에 있는 모든 그림을 삭제하는 방법 또는 특정 영역에 있는 모든 그림을 삭제하는 방법을 포스팅 하려고 합니다.
스크립트 내용은 아주 짧으니 참고하시면 됩니다.
Sub delPic() '영역안의 사진 지우기
Dim cwkbook As Workbook
Dim cwkSht As Worksheet
Dim shpC As Shape
Dim rngShp As Range
Dim rngAll As Range
Dim rngStartValue As String
Dim rngEndValue As String
Set cwkbook = ActiveWorkbook
Set cwkSht = cwkbook.ActiveSheet
rngStartValue = "A1"
rngEndValue = "z9999"
Set rngAll = cwkSht.Range(rngStartValue, rngEndValue)
For Each shpC In cwkSht.Shapes
Set rngShp = shpC.TopLeftCell
If Not Intersect(rngAll, rngShp) Is Nothing Then
shpC.Delete
End If
Next shpC
Set rngAll = Nothing
Set rngShp = Nothing
End Sub
스크립트 상단에 각종 변수를 정의해 주게 되는데요. 워크북 (엑셀 파일) 과 워크시트 (시트) 를 지정해주는 부분이 있습니다. 이곳에서는 일단 현재 활성화된 파일의 활성화된 워크시트를 선택해 주었습니다. 만약 특정 엑셀 파일을 지정할 계획이고 해당 엑셀 파일에 특정 시트에 대해 작업을 해주어야 한다면 해당 부분만 아래와 같이 작성해주면 됩니다.
Set cwkbook = Excel.Workbooks("엑셀파일이름.xlsx")
Set cwkSht = cwkbook.Worksheets("해당워크시트이름")
그 아래에 rngStartValue 와 rngEndValue 를 이용하여 영역의 시작부분과 끝부분의 셀 이름을 정해주면 해당 셀안에 있는 모든 그림은 삭제가 됩니다.
만약 세로로 같은 열에 있는 그림만 삭제를 해야 한다면 시작칸과 종료칸의 열 번호를 동일하게 지정해 주면 됩니다.
뎃글, 공감 은 블로그 작성자에게 큰 힘이 된답니다. 도움이 되었다 생각되시면 클릭!! 부탁드려요~