엑셀로 PPT(프리젠테이션) 파일을 일괄료 만들어 보기
영어 단어장 또는 일본어 단어장을 PPT로 만들어 줍니다.
회사에서 PPT로 발표할때, 데이터를 이용해서 한꺼번에 PPT자료를 만들 수 있습니다.
이곳에서 만드는 PPT는 텍스트뿐만 아니라, 이미지, 그리고 음성 미디어 파일을 한꺼번에 PPT파일로 만들어 줍니다.
아래 유튜브 동영상이 바로 이 프로그램을 이용해서 만든 PPT입니다.
사용법은 간단합니다.
1. PPT 파일을 미리 만들어야 합니다. (PPT파일 서식을 넣어 놓은 PPT파일 입니다)
메뉴 - 보기 - 슬라이드 마스터
제목과 텍스트1, 텍스트 2를 만들어 저장합니다.
2. 본 프로그램으로 만들어 놓은 PPT파일을 선택합니다.
3. 데이터 칼럼 및 이미지 크기 등을 지정합니다.
4. PPT파일 일괄 생성 버튼을 클릭합니다.
|
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
Option Explicit
Sub 피피티_파일선택()
Dim i_fullpath, i_file, i_folder As String
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.InitialFileName = ThisWorkbook.Path & "\"
.Filters.Clear
.Filters.Add "PPT 파일을 선택하세요", "*.ppt*"
If .Show = True Then
i_fullpath = .SelectedItems(1)
i_file = Right(i_fullpath, Len(i_fullpath) - InStrRev(i_fullpath, "\"))
i_folder = Left(i_fullpath, Len(i_fullpath) - Len(i_file))
End If
End With
If i_file = "" Then Exit Sub
Cells(4, 5) = i_folder
Cells(5, 5) = i_file
End Sub
Sub 피피티_폴더선택(i_caption As String)
Dim i_folder As String
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Cells(4, 5)
If .Show = -1 Then
i_folder = .SelectedItems(1)
End If
End With
If i_folder = "" Then Exit Sub
If i_caption = "음성1폴더" Then
Cells(12, 5) = i_folder
ElseIf i_caption = "음성2폴더" Then
Cells(13, 5) = i_folder
End If
End Sub
Sub ExcelToPPT()
Dim i_sheet, j_sheet, t_sheet As Worksheet
Set i_sheet = Sheets("대쉬보드")
Set j_sheet = Sheets("데이터")
'작업할 PPT 파일 및 폴더 정보
Dim i_power_point As PowerPoint.Application
Dim i_presentation As PowerPoint.Presentation
Dim i_slide As PowerPoint.Slide
'파워포인트 슬라이드 열기
Dim i_ppt_folder, i_ppt_file As String
i_ppt_folder = i_sheet.Cells(4, 5)
i_ppt_file = i_sheet.Cells(5, 5)
Set i_power_point = New PowerPoint.Application
On Error Resume Next
Set i_presentation = i_power_point.Presentations(i_ppt_file)
If Err.Number <> 0 Then
Set i_presentation = i_power_point.Presentations.Open(i_ppt_folder & i_ppt_file, msoFalse)
Err.Clear
End If
On Error GoTo 0
i_power_point.Visible = True
i_power_point.Activate
'엑셀 워크 쉬트에서 작업하기
'i, j, ii, jj 변수는 루핑용 변수임, MR = MaxRow를 뜻하며, 데이터가 있는 마지막 셀번호
Dim i, j, ii, jj, MR As Integer
Dim i_count As Integer
MR = i_sheet.Cells.Find("*", , , , xlByRows, xlPrevious).Row
i_count = i_presentation.Slides.Count
'만약 기존슬라이드가 1장보다 많을때는. 슬라이드 앞 1장만 남기기
If i_count > 1 Then
For ii = i_count To 2 Step -1
i_presentation.Slides(ii).Delete
Next ii
i_count = 1
End If
'데이터 칼럼(열)의 속성(텍스트, 이미지, mp3 지정)
Dim i_col_txt_1, i_col_txt_2, i_col_img_1 As Integer
i_col_txt_1 = i_sheet.Cells(8, 5)
i_col_txt_2 = i_sheet.Cells(9, 5)
i_col_img_1 = i_sheet.Cells(10, 5)
Dim i_img_top, i_img_left, i_img_size As Integer
i_img_top = i_sheet.Cells(11, 7)
i_img_left = i_sheet.Cells(11, 8)
i_img_size = i_sheet.Cells(11, 9)
Dim i_folder_mp3_1, i_folder_mp3_2 As String
i_folder_mp3_1 = i_sheet.Cells(12, 5)
i_folder_mp3_2 = i_sheet.Cells(13, 5)
'슬라이드에 엑셀 텍스트, mp3파일, 이미지 붙여넣기
Dim i_audio_shape, i_audio_shape2 As Object
Dim i_effect, i_effect2 As Effect
Dim i_audio_file As String
Dim i_picture As Object
For i = 2 To MR
'텍스트 1이 빈칸이면 루프 스킵
If j_sheet.Cells(i, i_col_txt_1) = "" Then GoTo end_of_for_i
Set i_slide = i_presentation.Slides.Add(i_count, ppLayoutCustom)
i_audio_file = "" & Format(i_count, "00") & ".mp3"
'슬라이드에 엑셀 텍스트를 텍스트로 그냥 넣기
With i_slide
If i_col_txt_1 <> 0 Then .Shapes(1).TextEffect.Text = j_sheet.Cells(i, i_col_txt_1)
If i_col_txt_2 <> 0 Then .Shapes(2).TextEffect.Text = j_sheet.Cells(i, i_col_txt_2)
End With
'슬라이드에 엑셀 텍스트를 이미지로 변경해서 넣기
If i_col_img_1 <> 0 Then
j_sheet.Cells(i, i_col_img_1).CopyPicture xlScreen, xlPicture
With i_slide
.Shapes.PasteSpecial
With .Shapes(.Shapes.Count)
.Left = i_img_top
.Top = i_img_left
.Width = i_img_size
End With
End With
End If
'슬라이드에 미디어파일 넣기
If i_folder_mp3_1 <> "" Then
Set i_audio_shape = i_slide.Shapes.AddMediaObject2(i_folder_mp3_1 & "\" & i_audio_file, msoFalse, msoTrue, 10, 10)
Set i_effect = i_slide.TimeLine.MainSequence.AddEffect(i_audio_shape, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
With i_effect
.EffectInformation.PlaySettings.HideWhileNotPlaying = True
End With
End If
If i_folder_mp3_2 <> "" Then
Set i_audio_shape2 = i_slide.Shapes.AddMediaObject2(i_folder_mp3_2 & "\" & i_audio_file, msoFalse, msoTrue, 10, 100)
Set i_effect2 = i_slide.TimeLine.MainSequence.AddEffect(i_audio_shape2, msoAnimEffectMediaPlay, , msoAnimTriggerWithPrevious)
i_effect2.MoveTo 1
With i_effect2
.EffectInformation.PlaySettings.HideWhileNotPlaying = True
End With
End If
i_count = i_count + 1
end_of_for_i:
Next i
Set i_presentation = Nothing
Set i_power_point = Nothing
End Sub
|
cs |
