원클릭

안녕하세요

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

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

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

안녕하세요

오늘은 한글파일 내에 존재하는 그림만을 추출하여 파일로 저장하는 프로그램을 만들어 보겠습니다.

우선 E드라이브 접수 폴더 내에 아래 한글파일이 있습니다.

여기에서 들어있는 증명사진?을 파일로 추출해보겠습니다.

코딩 내용입니다.

우선 관련 라이브러리를 불러와 주고요

import win32com.client as win32
import os
import fnmatch

한글개체를 생성합니다.
hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

E드라이브 밑에 접수폴더내에 포함되어 있는 한글파일을 검색합니다.
dir1="E:₩₩접수₩₩"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)

모든 파일을 열면서

for file in filename:
  hwp.Open(dir1+file, "HWP", "forceopen:true")

문서내에 포함되어 있는 컨트롤을 검색합니다.

컨트롤이란 문서내에 있는 각종 자료? 양식? 같은 것을 말합니다.

그림도 될 수 있고 표도 될 수 있고요

맨 처음 obj 에 넣게되는 것은 문서 내에 첫번째 컨트롤입니다.
  obj = hwp.HeadCtrl

그리고 마지막 컨트롤까지 검색을 합니다.

  i = 0
  while obj!= None :

컨트롤이 그림인지를 판별을 해야 하는데요

CtrlID 값을 보고 판단할 수 있습니다.

저희가 원하는 것은 그림입니다.

아래 표를 보면 gso 가 그림임을 알 수 있습니다.

그래서 그림 컨트롤이면
    idnum = obj.CtrlID
    if(idnum=="gso"):

해당 컨트롤으로 커서를 이동하고요
      paramSet = obj.GetAnchorPos(0);
      list1 = paramSet.Item("List")
      para = paramSet.Item("Para")
      pos = paramSet.Item("Pos")
      hwp.SetPos(list1, para, pos)

그림 컨트롤을 선택합니다.
      hwp.HAction.Run("SelectCtrlFront")

그리고 그림파일 이름을 설정합니다.

이름은 한글파일명(.hwp제외) + 사진번호 + .png로 설정합니다.
      filen=file[:-4]
      name=filen+str(i+1)+".png"

그리고 사진추출 폴더내에 저장합니다.
      hwp.HAction.GetDefault("PictureSave",hwp.HParameterSet.HShapeObjSaveAsPicture.HSet)
      option = hwp.HParameterSet.HShapeObjSaveAsPicture
      option.Path = "E:/사진추출/"+name
      option.Ext="png"
      hwp.HAction.Execute("PictureSave",hwp.HParameterSet.HShapeObjSaveAsPicture.HSet)

다음 컨트롤 개체로 이동을 해서 위 작업을 반복합니다.

      i=i+1
     obj=obj.Next

모든 작업이 끝나면 한글을 종료합니다.
hwp.Clear(1);
hwp.Quit()

실행한 결과입니다.

그림추출 폴더 내에 사진들이 잘 저장이 되어 있는 것을 확인할 수 있습니다!!

감사합니다.

import win32com.client as win32
import os
import fnmatch

hwp = win32.gencache.EnsureDispatch("HWPFrame.HwpObject")

dir1="E:₩₩접수₩₩"
filename=fnmatch.filter(os.listdir(dir1),'*.hwp')
print(filename)

for file in filename:
    hwp.Open(dir1+file, "HWP", "forceopen:true")
    obj = hwp.HeadCtrl
    i = 0
    while obj!= None :
            idnum = obj.CtrlID
            if(idnum=="gso"):
                paramSet = obj.GetAnchorPos(0);
                list1 = paramSet.Item("List")
                para = paramSet.Item("Para")
                pos = paramSet.Item("Pos")
                hwp.SetPos(list1, para, pos)
                hwp.HAction.Run("SelectCtrlFront")
                filen=file[:-4]
                name=filen+str(i+1)+".png"
                hwp.HAction.GetDefault("PictureSave",hwp.HParameterSet.HShapeObjSaveAsPicture.HSet)
                option = hwp.HParameterSet.HShapeObjSaveAsPicture
                option.Path = "E:/사진추출/"+name
                option.Ext="png"
                hwp.HAction.Execute("PictureSave",hwp.HParameterSet.HShapeObjSaveAsPicture.HSet)
                i=i+1
            obj=obj.Next

hwp.Clear(1);
hwp.Quit()

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

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

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

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

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

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