원클릭

안녕하세요

오늘은 엑셀에 있는 그림을 자동으로 저장하는 프로그램을 짜보도록 하겠습니다.

먼저 아래와 같은 그림이 있구요

그림을 저장시 구분하기 위하여 박지성.jpg, 이영표.jpg, ... 이런 식으로 저장을 해보겠습니다.

VBA에서는 그림을 바로 저장하지 못합니다.

그래서 꼼수를 쓰는게

맨 먼저 차트개체를 생성하고

그림을 카피를 한 다음에 차트개체에 붙여넣기를 합니다.

그리고 차트개체를 그림으로 저장하게 됩니다.

코딩 내용입니다.

차트개체를 생성합니다.

Dim Mychart As ChartObject

차트개체를 대략 10,10 위치에 20,20 크기로 만들어 놓습니다. 아무값이나 괜찮습니다.

Set Mychart = ActiveSheet.ChartObjects.Add(10, 10, 20, 20)

차트개체의 이름을 임의로 짓습니다. 'temp' 로 지었습니다.
Mychart.Name = "temp"

그리고 현재 시티의 모든 그림을 순환하면서

For Each Pic In ActiveSheet.Pictures

그림을 선택하고
  Pic.Select

그림의 가로,세로크기를 일단 저장합니다.(뒤에 이 값을 다시 쓸겁니다.)
  oldwidth = Pic.Width
  oldheight = Pic.Height

그림의 가로세로 크기를 원래대로 되돌립니다.

(엑셀에 보여지는 비율 및 크기로 저장 시 아래 문구를 삭제하셔야 합니다.)
  Selection.ShapeRange.LockAspectRatio = msoTrue
  Selection.ShapeRange.ScaleHeight 1, msoTrue, msoScaleFromTopLeft

그림의 클립보드에 카피하고요.
  Pic.Copy

그림을 저장 시 앞셀의 내용으로 저장하게 됩니다.

따라서 지금 그림이 위치한 셀의 위치는  Pic.TopLeftCell.Address 로 가져오고요.그 앞의 셀이므로 오프셋을 아래처럼 Offset([0], [-1])을 주면 앞 셀의 내용을 가져오게 됩니다.

  picname = Range(Pic.TopLeftCell.Address).Offset([0], [-1])

차트개체의 크기를 그림의 가로,세로 크기로 수정합니다.
  Mychart.Width = Pic.Width
  Mychart.Height = Pic.Height

여기까지 실행을 하시면

1에 보시는 것처럼 박지성의 사진이 원래 크기대로 돌아갔구요.

2에 보시는 것처럼 차트개체의 크기가 그림의 크기와 같아진 것을 볼 수 있습니다.

그리고 차트개체를 활성화 한 다음

  ActiveSheet.ChartObjects("temp").Activate

붙여넣기를 하면 차트개체에 사진이 표시되게 됩니다.
  ActiveChart.Paste

이 상태에서 차트개체를 저장하게 되면 사진이 저장되게 됩니다.
  ActiveChart.Export Filename:="e:\사진\" + picname + ".jpg", filtername:="jpg"

다시 사진은 원래 크기대로 되돌려야 됩니다.

사진을 다시 선택하고
  Pic.Select

사진의 가로,세로 크기를 다시 지정해줍니다.
  Selection.ShapeRange.LockAspectRatio = msoFalse
  Pic.Width = oldwidth
  Pic.Height = oldheight

Next

그림을 다 저장했으면 차트개체는 필요 없으므로 삭제해줍니다.

Mychart.Delete

실행 결과입니다.

그림이 잘 저장되었네요!!

엑셀파일도 같이 올려드립니다.

궁금하신 사항이나 도움이 필요하시면 댓글 부탁드립니다.

감사합니다!!

Dim Mychart As ChartObject

Set Mychart = ActiveSheet.ChartObjects.Add(10, 10, 20, 20)
Mychart.Name = "temp"


For Each Pic In ActiveSheet.Pictures
    Pic.Select
    oldwidth = Pic.Width
    oldheight = Pic.Height
    Selection.ShapeRange.LockAspectRatio = msoTrue
    Selection.ShapeRange.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
    Pic.Copy
    
    picname = Range(Pic.TopLeftCell.Address).Offset([0], [-1])
    Mychart.Width = Pic.Width
    Mychart.Height = Pic.Height
    ActiveSheet.ChartObjects("temp").Activate
    ActiveChart.Paste
    ActiveChart.Export Filename:="e:\\사진\\" + picname + ".jpg", filtername:="jpg"
    Pic.Select
    Selection.ShapeRange.LockAspectRatio = msoFalse
    Pic.Width = oldwidth
    Pic.Height = oldheight
    
Next
Mychart.Delete

안녕하세요

오늘은 엑셀에서 그림의 위치를 구해보고자 합니다.

그림의 위치를 구할 때에 그림이 위치한 셀 위치를 구하거나 절대위치를 구하는 두가지 방법이 있습니다.

1. 먼저 셀의 위치를 구하는 방법은 다음과 같습니다.

For Each Pic In ActiveSheet.Pictures

  Cells(1, 2) = Pic.TopLeftCell.Address

즉 그림 개체의 좌상단이 속해있는 셀의 위치를 가져오구요

그림에서 보시는 바와 같이  'C1' 위치를 가져옵니다.

  Cells(2, 2) = Pic.BottomRightCell.Address

그림 개체 우하단의 셀의 위치를 가져옵니다.

'F6' 이 되겠죠

추가적으로 그림이 위치한 셀영역을 선택하려고 하면 이렇게 하시면 됩니다.

Range(Pic.TopLeftCell.Address, Pic.BottomRightCell.Address).Select

2. 절대 위치를 구하는 방법은 다음과 같습니다.

For Each Pic In ActiveSheet.Pictures

  Cells(3, 2) = Pic.Top

즉 그림 개체의 상단의 절대위치를 가져오고요.

  Cells(4, 2) = Pic.Left

그림 개체의 좌측 절대위치를 가져옵니다.

  Cells(5, 2) = Pic.Height

그림 개체의 좌측 절대위치를 가져옵니다.

  Cells(6, 2) = Pic.Width

그림 개체의 좌측 절대위치를 가져옵니다.

3. 실행결과입니다.

그림의 좌상단(C1)과 우하단(F6) 셀의 위치를 잘 가져왔고요

또한 상단(10.5), 좌측(174), 높이(148.5), 너비(163.5) 의 절대 위치를 가져왔습니다.

VBA 코드입니다.

참고바랍니다.

Sub Ext()
For Each Pic In ActiveSheet.Pictures
    Cells(1, 2) = Pic.TopLeftCell.Address
    Cells(2, 2) = Pic.BottomRightCell.Address
    Cells(3, 2) = Pic.Top
    Cells(4, 2) = Pic.Left
    Cells(5, 2) = Pic.Height
    Cells(6, 2) = Pic.Width
Next
End Sub

이번 시간에는 명단에 사진을 자동으로 넣어 보기로 하겠습니다.

예를 들어 매년, 매월, 또는 매주 명단이 바뀌게 되면 그에 따라 사진도 같이 바꿔줘야 되는데 상당히 번거롭습니다.

아래 보안구역 출입명부가 있습니다.

그리고 이 엑셀파일이 있는 폴더 밑에 하위폴더로 '사진파일'이 있구요.

그 '사진파일' 폴더에는 각 개인의 사진이 있습니다.

아래는 VBA코드입니다.

우선 현지 활성화된 시트에 있는 모든 그림을 삭제해줍니다.

이 작업을 안하게 되면 기존 사진이 안 지워지고 위에 새로운 사진이 덧씌워지게 됩니다.

Dim Pic As Object
    For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic

그리고 현재작업중인 엑셀의 경로를 가져옵니다.
Str1 = ActiveWorkbook.Path

i = 0
Do While Cells(6 + i, 4) <> ""

명단의 이름을 가져오고 그에 맞는 파일이 '사진폴더'에 있는 지 검사합니다.
Name = Cells(6 + i, 4)
str2 = Str1 & "\사진파일\" & Name & ".png"
ret = Dir(str2)

사진폴더에 해당사진이 있으면
If ret <> "" Then

해당사진의 경로를 filename2 에 저장해주고요
filename2 = Str1 & "\사진파일\" + ret

해당사진을 불러와서 Pic 개체에 넣어줍니다.
Set Pic = ActiveSheet.Pictures.Insert(filename2)

그리고 사진을 넣을 장소를 선택을 하고요. 명단의 옆 셀이 되겠죠
Range(Cells(6 + i, 5), Cells(6 + i, 5)).Select
Set Imagecell = ActiveCell.MergeArea

Pic 개체의 위치를 설정해줍니다. 아까 선택했던 셀의 좌,우,너비,높이 위치를 알려줍니다.
With Pic
  .ShapeRange.LockAspectRatio = msoFalse
  .Left = Imagecell.Left + 1
  .Top = Imagecell.Top + 1
  .Width = Imagecell.Width - 1
  .Height = Imagecell.Height - 1
End With
End If

아래 명단으로 이동하여 끝까지 반복합니다.
i = i + 1
Loop

코드를 실행한 결과입니다.

그림이 셀사이즈에 딱 맞게 잘 들어갔네요!!

아래는 관련 엑셀파일과 코딩 내용입니다.

감사합니다.

Dim Pic As Object
For Each Pic In ActiveSheet.Pictures
Pic.Delete
Next Pic

Str1 = ActiveWorkbook.Path
i = 0
Do While Cells(6 + i, 4) <> ""
Name = Cells(6 + i, 4)
str2 = Str1 & "\사진파일\" & Name & ".png"
ret = Dir(str2)
If ret <> "" Then
filename2 = Str1 & "\사진파일\" + ret
Range(Cells(6 + i, 5), Cells(6 + i, 5)).Select
Set Pic = ActiveSheet.Pictures.Insert(filename2)
Set Imagecell = ActiveCell.MergeArea
With Pic
.ShapeRange.LockAspectRatio = msoFalse
.Left = Imagecell.Left + 1
.Top = Imagecell.Top + 1
.Width = Imagecell.Width - 1
.Height = Imagecell.Height - 1
End With
End If
i = i + 1
Loop

이번 시간에는 VBA로 사용자 정의 함수(user defined function) 을 만들어 보도록 하겠습니다.

엑셀을 사용하다 보면 기본적으로 많이 쓰는 함수가  sum 함수입니다.

이것들은 엑셀에서 기본적으로 제공해주는 함수인데요

VBA를 통하여 똑같은 기능을 하는 함수를 따로 만들 수 있습니다.

이것을 더 응용해서 자신에게 맞는 함수를 만들 수도 있겠죠

sum 함수를 만들기 위해서는 먼저 엑셀을 실행하시고 Alt + F11을 누르시면

아래와 같은  VBA 편집창이 나오는데요

여기서 메뉴 => 삽입 => 모듈을 클릭하시면 왼쪽에 모듈에  Module이 생성됩니다

모듈을 더블클릭 하시면 오른쪽에 코드를 작성할 수 있는 편집창이 하나 뜨게 되는데요

여기에서 우리 원하는 함수를 작성해 주시면 됩니다.

우선 함수를 만든다고 선언을 해줍니다.

함수 이름은  sumsum이라고 짓겠습니다.

인수는 range 형태로 rng 변수로 받습니다.(예를 들어 "a1:b10" 을 인수로 받게 되는 것입니다.)

Function sumsum(rng As Range)

처음 합은 0이므로

sum1 = 0

c 라는  range 형의 변수를 선언해줍니다.

Dim c As Range

그리고 아까전에 인수로 받았던  rng 의 영역에 대해서 모든 셀의 내용을 sum1  변수에 더합니다.

For Each c In rng
       sum1 = sum1 + c.Value
Next c

그리고 sumsum 변수에 sum1을 대입합니다. 함수이름에 변수를 넣는것은 해당 값으로 함수를 리턴하라는 이야기입니다.

따라서 rng 영역에 있는 모든 값을 더해서 리턴이 되는겁니다.

sumsum = sum1

함수 끝..

End Function

VBA 편집창을 나와서 엑셀에서 sumsum 함수가 잘 돌아가는지 테스트를 해보면....

선택된 영역의 숫자의 합 10이 제대로 나오는 것을 확인 할 수 있습니다!!

sum 뿐만 아니라 사용자가 원하는 함수를 만들 수가 있겠지요

궁금하신 사항이 있으시면 댓글로 남겨주세요

감사합니다.

Function bb(rng As range)
sum1 = 0
Dim c As range
For Each c In rng
    sum1 = sum1 + c.Value
Next c
bb = sum1
End Function