원클릭

안녕하세요

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

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

그림을 저장시 구분하기 위하여 박지성.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

안녕하세요

이번 시간에는 한글의 양식개체(체크버튼, 라디오버튼, 콤보박스)의 정보를 엑셀로 옮기는 작업을 해보려 합니다.

먼저 아래와 같은 설문지가 있습니다.

이름을 입력할 수 있는 누름틀(엄밀히 말하면 양식개체는 아님)

성별을 선택할 수 있는 라디오버튼

결혼여부를 선택할 수 있는 체크버튼

거주지를 선택할 수 있는 콤보박스로 구성되어 있습니다.

이런 설문조사 파일들의 정보들을 다음의 엑셀파일에 옮기게 됩니다.

그럼 코드 내용을 보도록 하겠습니다.

많이 보던 아래 코드를 넣어주고요.

# -*- coding: cp949 -*-
import win32com.client as win32
import os
import fnmatch
import time

엑셀과 한글 개체를 불러옵니다.
xl=win32.gencache.EnsureDispatch("Excel.Application")
xl.Workbooks.Open("e:/move2/정리.xlsx")
xl.Visible=True
hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

폴더내에 들어있는 모든 한글파일을 검색하고요
dir1=os.getcwd()
dir1="E:/move2/접수/"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)

모든 파일을 열면서
i=1
for file in filename:
  hwp.Open(dir1+file, "HWP", "forceopen:true")

"이름"이란 글자를 찾구요
  hwp.HAction.GetDefault("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
  option = hwp.HParameterSet.HFindReplace
  option.FindString = "이름"
  option.IgnoreMessage = 1;
  option.Direction = hwp.FindDir("AllDoc");
  hwp.HAction.Execute("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);

옆 칸으로 이동합니다.
  hwp.HAction.Run("MoveRight");

한번 더 이동하면 누름틀 안으로 진입하게 됩니다.
  hwp.HAction.Run("MoveRight");

마지막 글자까지 선택하고요.
  hwp.HAction.Run("MoveSelLineEnd");

카피를 해주고요
  hwp.HAction.Run("Copy");

엑셀에 붙여놓을 셀을 선택하고

  xl.ActiveSheet.Cells(i + 1, 1).Select()

붙여줍니다.
  xl.ActiveSheet.Paste()

그리고 양식개체에 접근하는 법입니다.

gender = hwp.XHwpDocuments.Item(0).XHwpFormRadioButtons.ItemFromName("RadioButton1").Value

여기에서  Item(0) 이 의미하는 것은 첫번째 탭을 의미합니다.

엑셀에서 말하는 시트의 첫번째라고 생각하시면 됩니다.

그리고 해당 탭에 있는 라디오 버튼의 속성 중 이름이  "RadioButton1"이라고 되어 있는 개체의 값을 가져옵니다.

체크박스와 콤보박스의 정보를 가져옵니다.

marriage = hwp.XHwpDocuments.Item(0).XHwpFormCheckButtons.ItemFromName("CheckBox1").Value
address = hwp.XHwpDocuments.Item(0).XHwpFormComboBoxs.ItemFromName("ComboBox1").Text

추가로 콤보박스의 코드는 아래 그림과 같으니 참고하시기 바랍니다.

남자에 체크했으면 남자이고, 체크하지 않았으면 여자입니다.
if gender == 1:
  xl.ActiveSheet.Cells(i + 1, 2).Value = "남자"
else:
  xl.ActiveSheet.Cells(i + 1, 2).Value = "여자"

결혼여부에 체크했으면 기혼이고 아니면 미혼입니다.
if marriage == 1:
  xl.ActiveSheet.Cells(i + 1, 3).Value = "기혼"
else:
  xl.ActiveSheet.Cells(i + 1, 3).Value = "미혼"

주소를 넣어주고요
  xl.ActiveSheet.Cells(i + 1, 4).Value = address
i=i+1

한글과 엑셀을 종료합니다.

hwp.Quit()
xl.ActiveWorkbook.Save()
xl.ActiveWorkbook.Close()

실행을 하시면 아래와 같이 잘 옮겨진 것을 볼 수 있습니다.

관련 파일도 같이 올려드립니다. 참고하시기 바랍니다.

추가로 궁금하신 사항있으시면 댓글부탁드립니다.

감사합니다.

# -*- coding: cp949 -*-
import win32com.client as win32
import os
import fnmatch
import time

xl=win32.gencache.EnsureDispatch("Excel.Application")
xl.Workbooks.Open("e:/move2/정리.xlsx")
xl.Visible=True
hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

dir1=os.getcwd()
dir1="E:/move2/접수/"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)
i=1
for file in filename:
    hwp.Open(dir1+file, "HWP", "forceopen:true")
    hwp.HAction.GetDefault("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
    option = hwp.HParameterSet.HFindReplace
    option.FindString = "이름"
    option.IgnoreMessage = 1;
    option.Direction = hwp.FindDir("AllDoc");
    hwp.HAction.Execute("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
    hwp.HAction.Run("MoveRight");
    hwp.HAction.Run("MoveRight");
    hwp.HAction.Run("MoveSelLineEnd");
    hwp.HAction.Run("Copy");
    xl.ActiveSheet.Cells(i + 1, 1).Select()
    xl.ActiveSheet.Paste()
    gender = hwp.XHwpDocuments.Item(0).XHwpFormRadioButtons.ItemFromName("RadioButton1").Value
    marriage = hwp.XHwpDocuments.Item(0).XHwpFormCheckButtons.ItemFromName("CheckBox1").Value
    address = hwp.XHwpDocuments.Item(0).XHwpFormComboBoxs.ItemFromName("ComboBox1").Text
    if gender == 1:
        xl.ActiveSheet.Cells(i + 1, 2).Value = "남자"
    else:
        xl.ActiveSheet.Cells(i + 1, 2).Value = "여자"
    if marriage == 1:
        xl.ActiveSheet.Cells(i + 1, 3).Value = "기혼"
    else:
        xl.ActiveSheet.Cells(i + 1, 3).Value = "미혼"
    xl.ActiveSheet.Cells(i + 1, 4).Value = address
    i=i+1
hwp.Quit()
xl.ActiveWorkbook.Save()
xl.ActiveWorkbook.Close()

안녕하세요.

오늘은 한글파일 내에 표의 내용을 엑셀로 옮기는 작업을 해볼까 합니다.

지원서 같은 것을 한글로 접수받고 엑셀로 정리를 한다고 하였을 때

지원가 많다보면 많이 번거로울 것입니다.

이것을 자동화해보도록 하겠습니다.

우선 지원서가 아래와 같다고 해봅시다!!

그리고 이 한글파일을 정리할 엑셀파일은 다음과 같습니다.

아래는 표의 내용을 엑셀파일로 자동으로 옮겨주는 코드입니다.

아래 코드는 전에 작성했던 코드랑 동일하므로 설명은 생략하겠습니다.

# -*- coding: cp949 -*-
import win32com.client as win32
import os
import fnmatch

엑셀을 사용할 수 있는도록 엑셀개체를 생성합니다.
xl=win32.gencache.EnsureDispatch("Excel.Application")

그리고 E드라이브에 있는 엑셀파일을 열어줍니다.

xl.Workbooks.Open("e:정리.xlsx")

여기까지 코드를 실행하면 엑셀이 실행이 안된것 처럼 보여집니다.

그러나 보이지만 않을 뿐 백그라운드 상으로는 파일을 열고 있습니다.

만약에 엑셀을 보고 싶다 그러면 아래 코드를 추가로 써줍니다.

xl.Visible=True

그리고 한글개체를 생성하고요.
hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

E드라이브의 접수 폴더 밑에 있는 모든  한글파일을 열어 줍니다.
dir1=os.getcwd()
dir1="E:₩₩접수₩₩"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)

지원서 파일에는 아래와 같은 항목이 존재합니다.
data=["이름","생년월일", "직장명", "직위", "주소","연락처"]

모든 파일을 열면서
i=1

for file in filename:
  hwp.Open(dir1+file, "HWP", "forceopen:true")
  hwp.HAction.GetDefault("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
  option=hwp.HParameterSet.HFindReplace
  j=0

각 항목을 검색합니다.
  for item in data:

    option.FindString = data[j]
    option.IgnoreMessage = 1;
    option.Direction = hwp.FindDir("AllDoc");
    hwp.HAction.Execute("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);

각 항목을 찾았으면 해당 항목에서 오른쪽 버튼을 한 번 누름니다.

그러면 찾았던 항목의 옆 칸으로 이동하겠죠?

여기에 우리가 원하는 내용이 있습니다!!

    hwp.HAction.Run("MoveRight");

그리고 해당 칸의 마지막까지 선택을 해주고요

    hwp.HAction.Run("MoveSelLineEnd");

카피를 해줍니다. Ctrl + C 와 같습니다.
    hwp.HAction.Run("Copy");

그리고 엑셀에서 붙여넣기 할 셀을 선택해주고요

    xl.ActiveSheet.Cells(i+1, j+1).Select()

붙여넣기 해줍니다. Ctrl + V 와 같습니다.

    xl.ActiveSheet.Paste()

반복해줍니다.
     j=j+1
  i=i+1

한글을 종료해주고요.
hwp.Quit()

엑셀은 저장해줍니다.
xl.ActiveWorkbook.SaveAs("e:정리.xlsx")

엑셀을 종료하고요
xl.ActiveWorkbook.Close()

코딩은 여기까지입니다.

코드를 실행해보면....

엑셀에 한그파일 지원서의 내용이 잘 들어가 있는 것을 확인하실 수 있습니다.

지원서 파일이 많으면 확실히 도움이 될거라 생각됩니다.

첨부파일 참고하시고요.

감사합니다.

import win32com.client as win32
import os
import fnmatch

xl=win32.gencache.EnsureDispatch("Excel.Application")
xl.Workbooks.Open("e:정리.xlsx")
#xl.Visible=True
hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

dir1=os.getcwd()
dir1="E:₩₩접수₩₩"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)
data=["이름","생년월일", "직장명", "직위", "주소","연락처"]
i=1
for file in filename:
    hwp.Open(dir1+file, "HWP", "forceopen:true")
    hwp.HAction.GetDefault("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
    option=hwp.HParameterSet.HFindReplace
    j=0
    for item in data:
        option.FindString = data[j]
        option.IgnoreMessage = 1;
        option.Direction = hwp.FindDir("AllDoc");
        hwp.HAction.Execute("RepeatFind", hwp.HParameterSet.HFindReplace.HSet);
        hwp.HAction.Run("MoveRight");
        hwp.HAction.Run("MoveSelLineEnd");
        hwp.HAction.Run("Copy");
        xl.ActiveSheet.Cells(i+1, j+1).Select()
        xl.ActiveSheet.Paste()
        j=j+1
    print(i)
    i=i+1

hwp.Quit()
xl.ActiveWorkbook.SaveAs("e:정리.xlsx")
xl.ActiveWorkbook.Close()

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

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

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

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

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

아래는 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