지난번에 작성해서 공개한 

에듀파인 기자재 정리 유틸리티가

엑셀로 모든 정보 자동작성해서 자료 뚝딱만듬

단, 그림은 제외하고 ... 였지만

 

이번에 업데이트 - 그림포함해서 자동작성!!

 

인터넷에서 엑셀에서 사진을 저장하는 방법 검색

출처 : https://blog.naver.com/rosa0189/221487594691

 

(1722) 사진(그림)을 파일로 저장하기 2 (엑셀 VBA 매크로)

조금전 올린 내용을 약간 개선했다. 엑셀에 삽입된 사진을 파일로 저장하는 기능. 사진 왼쪽 셀에 이름이 ...

blog.naver.com

기자재 이력카드를 다운 받은 후 여기 들어있는

기자재 사진을 "기자재 관리번호" 이름으로 저장

 

다음 매크로를 기자재 이력카드의 매크로에 넣고 실행하면

(xlsPic_VBA.txt가 매크로임)

 ==> 아래 실행화일의 압축화일 내에 들어 있음

 - 매크로 실행시 절대 엑셀시트를 마우스로 클릭하지 말고 실행 (오류남)

 - 기자재 이력카드의 그림위치에서 

 - 저장해야할 그림이름을 "기자재관리번호"로 저장하기 위해 위치 계산

 - 그림의 좌상단 셀을 기준으로 컬럼 왼쪽으로 5, 줄은 아래로 3

         (다음 그림의 적색박스 내 숫자의 의미)

'https://blog.naver.com/rosa0189/221487594691
Option Explicit
Sub export_Pictures_2()
    Dim pic As Picture                            '사진(pic)ture을 넣을 변수
    Dim picName As String                         '사진(pic)ture 이름(Name)을 넣을 변수
    Dim chtObj As ChartObject                     '차트(ch)ar(t) 개체(Obj)ect 넣을 변수
    Dim cht As Chart                              '차트(ch)ar(t) 넣을 변수
    Dim cellText As String
    Dim picNo As Integer
    Application.ScreenUpdating = False            '화면 업데이트 (일시)정지
    For Each pic In ActiveSheet.Pictures          '현재시트 모든 사진을 순환
        'cellText = pic.TopLeftCell.Offset(, -5).Value ' 디버그용
        picNo = picNo + 1                         ' 셀 병합되어서 병합시작 셀 위치 지정
        If pic.TopLeftCell.Offset(3, -5).Value <> "" Then  '사진 왼쪽셀이 공백이 아니라면
            picName = pic.TopLeftCell.Offset(3, -5).Value   '사진 이름 추출 (기자재관리번호)
            pic.Select                            '사진을 선택
            Selection.CopyPicture                 '선택된 사진을 사진복사
            Set chtObj = ActiveSheet.ChartObjects.Add(0, 0, pic.Width, pic.Height)
            chtObj.Chart.Paste                    '사진이 들어갈 프레임 역할을 할 차트개체를 변수에
           
            Set cht = chtObj.Chart                '차트개체의 차트를 변수에
            chtObj.Activate                       '차트개체 활성화
            With cht                              '차트에서
                .ChartArea.Select                 '차트영역을 선택
                .Paste                            '붙여 넣기
                .Export (ThisWorkbook.Path & "\" & picName & ".jpg")  '같은 경로에 .jpg로 저장
            End With
            chtObj.Delete                         '차트 개체 삭제
        End If
    Next pic
    Set chtObj = Nothing                          '개체변수(들) 초기화(메모리 비우기)
    Set cht = Nothing
End Sub

기자재 사진이 기자재관리번호.jpg 라는 그림으로 저장됨

그 그림들을 이 프로그램의 "Pictures"폴더에 저장

개정된 프로그램

 

FineEduAsset_V5web.zip
4.39MB

참고로 수정된 프로그램 사용설명서

 

블로그 이미지

DIYworld

,