관련글(지식인):
https://kin.naver.com/qna/detail.nhn?d1id=3&dirId=31301&docId=366372325&page=1#answer1
본 VBA는 왼쪽 그림과 같이 원하는 틀의 이미지를 여러개 자동으로 생성할 때 활용할 수 있습니다. 예를 들어 쇼핑몰의 옵션이미지, 단체 명찰, 상품의 태그, 그림 카드 등을 쉽게 일괄로 만들 수 있습니다.
엑셀에서는 시트상의 이미지 내보내기(그림저장)가 불가능하지만 파워포인트에서는 슬라이드 상의 도형들을 그림으로 저장(내보내기)이 가능합니다.
그래서 엑셀 목록과 연동하여 파워포인트에서 슬라이드상의 이미지를 조합하고 모여진 도형들을 그림으로 저장하는 식으로 연동된 자동화작업을 처리하면 됩니다.
엑셀에는 상품명, 할인율, 가격 등의 정보가 들어 있고
파워포인트 슬라이드에는 위 정보가 들어갈 텍스트상자가 여러개 있어야겠습니다. 파워포인트에서는 도형들을 선택해서 저장할 수도 있고 슬라이드를 통채로 저장할 수도 있습니다.
구체적인 작업 순서는 아래와 같습니다.
1. 엑셀에는 이미지에 들어갈 문구를 원하는 개수만큼 목록으로 만들어 놓습니다.
특히 B열에는 메인이미지로 들어갈 이미지의 주소가 들어 있습니다. 현재 매크로가 있는 폴더에 img폴더에 들어있는 상태입니다. 셀에 보이는 대로 문자열이 들어가게 됩니다. A열은 Img_1 도형에, C열은 Img_3 도형에, D열은 Img_4도형에 들어가게 됩니다.
2. 파워포인트에서는 이미지의 기본 틀을 구성합니다.
각각의 텍스트 상자의 폰트나 글자크기, 굵기, 색깔 등을 미리 수정, 적용합니다.
Img_Frame 은 테두리의 회색선입니다.
3. 매크로를 실행할 차례입니다. 파워포인트 Alt-F11창에서 삽입-모듈 추가하고 아래 코드를 붙여 넣습니다.
Sub Automate()
Dim FD As FileDialog
Dim xlsFile As String
Dim xlsApp As Object
Dim xlsBook As Object
Dim xlsSht As Object
Dim rng As Object
Dim lastRow As Long
Dim imgFile As String
Dim sld As Slide
Dim shp As Shape
Dim i As Integer
On Error GoTo Oops
Set FD = Application.FileDialog(msoFileDialogFilePicker)
With FD
.Filters.Add "상품목록 엑셀파일", "*.xls?"
.InitialFileName = ActivePresentation.Path & "\"
If .Show = -1 Then xlsFile = .SelectedItems(1)
End With
If xlsFile = "" Then Exit Sub
Set xlsApp = CreateObject("Excel.Application")
Set xlsBook = xlsApp.Workbooks.Open(xlsFile)
Set xlsSht = xlsBook.Worksheets(1)
lastRow = xlsSht.Cells(xlsSht.Rows.Count, "d").End(-4162).Row 'xlUp
If lastRow < 2 Then MsgBox "상품목록을 확인하세요.": GoTo Oops
Set sld = ActivePresentation.Slides(1)
For Each rng In xlsSht.Range("A2:A" & lastRow)
For i = 1 To 10
If i = 2 Then
imgFile = ActivePresentation.Path & "\" & rng.Offset(, i - 1)
If Len(Dir(imgFile)) > 0 Then
sld.Shapes("Img_" & i).Fill.UserPicture imgFile
sld.Shapes("Img_" & i).TextFrame.TextRange = ""
Else
sld.Shapes("Img_" & i).TextFrame.TextRange = imgFile & " not found!"
End If
Else
With sld.Shapes("Img_" & i).TextFrame.TextRange
.Text = rng.Offset(, i - 1).Text
End With
End If
sld.Shapes("Img_" & i).Select msoFalse
sld.Shapes("Img_Frame").Select msoFalse
'// 01.png 등으로 저장
imgFile = ActivePresentation.Path & "\" & rng & ".png"
ActiveWindow.Selection.ShapeRange.Export imgFile, ppShapeFormatPNG
Next i
'Exit For
Next rng
Oops:
xlsApp.Quit
Set xlsApp = Nothing
End Sub
그리고 F5로 실행하거나 창 닫고 일반화면에서 Alt-F8로 실행합니다.
목록이 들어 있는 엑셀파일을 선택하면 현재 폴더에 01.png~05.png 가 자동 생성됩니다.
내부적으로 각 도형을 변경 후 모두 선택한 다음 선택된 도형들을 .Export 로 하나의 이미지로 저장합니다.
이미지는 png , jpg, gif, emf, emf 등이 가능합니다.
Export 뒤에 옵션을 추가하면 생성이미지의 가로 세로 크기까지 지정할 수 있습니다.
결과 이미지:
첨부한 압축파일에는 '상품목록.xlsx, 이미지폴더, 상품이미지만들기.pptm '가 들어 있습니다.
VBA로 이미지를 일괄 생성하는 방법에 대한 소개로 이를 바탕으로
좀더 다양한 응용이 가능하겠습니다.
*** 2021.2 추가 - 지식인 답변
위에서 생성된 이미지를 원하는 특정사이즈로 저장하는 매크로를 추가합니다.
파워포인트에서 개체를 저장할 때 예를 들어 가로 860px로 저장하려면 860*0.75 로 개체사이즈를 줄여야 합니다.
1px = 0.75pt이기 때문입니다.
그리고 개체를 png이미지로 저장할 때 특히 텍스트 상자의 경우는 원하는 사이즈로 저장하는데 방해가 될 수 있고(더 큰 사이즈로 저장되는 경우가 많음) 현재 슬라이드상의 크기보다 큰 사이즈로 확대해서 저장시에 텍스트는 자동으로 확대가 되지 않습니다. 이를 해결하기 때문에 일단 임시로 EMF로 저장했다각 다시 이를 삽입하고 다시 EMF이미지를 확대해서 PNG로 저장하는 방식을 이용했습니다.
'// 용도: 파워포인트 슬라이드별 상품 설명 이미지 및 개체를 조합하여
'// 특정 사이즈 이미지로 일괄 생성
'// Copyright (C) konahn(at)naver.com
'// 사용시 저작권 표시 유지
'// 저작권자의 허락 없이 공개적 혹은 상업적 이용 금지
Option Explicit
Sub 상품이미지저장하기()
Dim pres As Presentation
Dim targetFolder As String
Dim targetFile As String, tempFile As String
Set pres = ActivePresentation
'//폴더 선택
With Application.FileDialog(msoFileDialogFolderPicker)
.AllowMultiSelect = False
.InitialFileName = pres.Path & "\"
.ButtonName = "현재 폴더 선택"
.Title = "이미지를 저장할 폴더로 들어가서 확인을 클릭하세요."
If .Show = -1 Then targetFolder = .SelectedItems(1)
End With
If Len(targetFolder) = 0 Then Exit Sub
'//파일명
targetFile = Left(pres.Name, InStr(pres.Name, ".") - 1) & "_000"
targetFile = InputBox("저장파일 패턴을 입력하세요" & vbNewLine & vbNewLine & _
"(예: Img_000 => Img_001.png, Img_002.png, ...)", "파일명 입력", targetFile)
If targetFile = "" Then Exit Sub
Dim sld As Slide
Dim shp As Shape
Dim oldWidth As Single
Dim w As Long, h As Long
For Each sld In pres.Slides
'이동
ActiveWindow.View.GotoSlide sld.SlideIndex
For Each shp In sld.Shapes
'선택
If shp.Visible Then shp.Select msoFalse
Next shp
'선택된 개체들 그룹화해서 EMF로 저장 후 재삽입해서 PNG로 저장
With ActiveWindow.Selection.ShapeRange.Group
'//임시로 EMF 저장(PNG로 바로 저장시 텍스트 비율유지 안됨)
tempFile = targetFolder & "\" & Format(sld.SlideIndex, targetFile) & ".emf"
.Export tempFile, ppShapeFormatEMF
'//EMF 재삽입후 PNG로 저장
Set shp = sld.Shapes.AddPicture(tempFile, msoFalse, msoTrue, .Left, .Top) ', .Width, .Height)
Kill tempFile
With shp
.LockAspectRatio = msoTrue
.ScaleWidth 1, msoTrue: .ScaleHeight 1, msoTrue
.Width = 860 * 0.75 '// 1px = 0.75pt
tempFile = targetFolder & "\" & Format(sld.SlideIndex, targetFile) & ".png"
.Export PathName:=tempFile, Filter:=ppShapeFormatPNG
.Delete
End With
.Ungroup
End With
Next sld
End Sub
처음 실행하면 이미지가 저장될 폴더를 선택합니다.
기본으로 매크로파일이 있는 현재 폴더로 시작합니다.
주의할 것은 파일선택처럼 파일이 마우스로 선택된 상태가 아니라
해당 폴더를 선택해서 안에 들어간 다음 현재폴더 선택을 누르세요.
그 다음 파일 패턴을 입력합니다. Format 함수에 들어갈 패턴이면 됩니다.
기본으로 "매크로 파일명_000" 입니다. 매크로파일명_001, 애크로파일명_002 이런식으로 저장됩니다.
이미지_# 이라고 입력하면 이미지_1, 이미지_2, 이미지_3 으로 저장됩니다.
이미지_000 이라고 입력하면 이미지_001, 이미지_002, 이미지_003 으로 저장됩니다.
테스트 파일 첨부합니다.
저작권 표시:
위 코드를 개인적, 비공개적으로만 이용하시기 바랍니다. 저작권 표시는 유지해주세요.
저는 현재로서는 영리를 추구하지 않기 때문에 이런 소스를 공개하고 지식을 나누고 있지만 그럼에도 불구하고 저의 노력이 들어간 위 코드를 저작권자의 허락 없이 무단으로 복제해서 이 코드를 판매한다든지 무단으로 공개한다든지 혹은 자신의 이익을 위해 상업적으로 이용하는 것은 저작권에 위배됨을 말씀드립니다.
'// 용도: 파워포인트 슬라이드별 상품 설명 이미지 및 개체를 조합하여 특정 사이즈 이미지로 일괄 생성 '// Copyright (C) konahn(at)naver.com '// 사용시 저작권 표시 유지 '// 저작권자의 허락 없이 공개적 혹은 상업적 이용 금지 |
'PPT+VBA' 카테고리의 다른 글
파워포인트 슬라이드 고해상도(고화질)로 저장 (0) | 2020.11.27 |
---|---|
룰렛 회전판 생성기 v2 (6) | 2020.10.16 |
회전 룰렛(회전판) 모음 및 자동 생성기 (12) | 2020.10.14 |
슬라이드의 테이블(표)과 차트의 데이터 연동시키기 (1) | 2020.10.08 |
[WordScatter] 슬라이드에 랜덤 단어 흩뿌리기 (2) | 2020.08.02 |
슬라이드 구역별로 페이지 번호 삽입 (1) | 2020.07.24 |
문장에 빈칸 도형 일괄 추가 매크로 (6) | 2020.07.20 |
유투브 영상 삽입 후 에러(온라인 비디오가 현재 차단되어 있습니다. Online videos are currently blocked.) 해결 방법 (0) | 2020.06.16 |
최근댓글