엑셀로 PPT파일을 자동으로 만들기

by 지천명영어 posted Apr 18, 2022
?

단축키

Prev이전 문서

Next다음 문서

ESC닫기

크게 작게 위로 아래로 댓글로 가기 인쇄

엑셀로 PPT(프리젠테이션) 파일을 일괄료 만들어 보기

 

영어 단어장 또는 일본어 단어장을 PPT로 만들어 줍니다.

회사에서 PPT로 발표할때, 데이터를 이용해서 한꺼번에 PPT자료를 만들 수 있습니다.

 

이곳에서 만드는 PPT는 텍스트뿐만 아니라, 이미지, 그리고 음성 미디어 파일을 한꺼번에 PPT파일로 만들어 줍니다.

 

아래 유튜브 동영상이 바로 이 프로그램을 이용해서 만든 PPT입니다. 

 

사용법은 간단합니다.

 

1. PPT 파일을 미리 만들어야 합니다. (PPT파일 서식을 넣어 놓은 PPT파일 입니다)

   메뉴 - 보기 - 슬라이드 마스터

   제목과 텍스트1, 텍스트 2를 만들어 저장합니다.

2. 본 프로그램으로 만들어 놓은 PPT파일을 선택합니다.

3. 데이터 칼럼 및 이미지 크기 등을 지정합니다.

4. PPT파일 일괄 생성 버튼을 클릭합니다.

 
이미지 2.png

 

파일은 다음과 같습니다.

 

1. 엑셀 파일 엑셀To파워포인트(지천명영어)_02.xlsm

2. PPT파일 test_ppt.pptx

 

소스코드는 다음과 같습니다.

 

 

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(45= i_folder
        Cells(55= i_file
 
End Sub
Sub 피피티_폴더선택(i_caption As String)
 
Dim i_folder As String
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Cells(45)
        If .Show = -1 Then
            i_folder = .SelectedItems(1)
        End If
    End With
    
    If i_folder = "" Then Exit Sub
    
    If i_caption = "음성1폴더" Then
        Cells(125= i_folder
    
    ElseIf i_caption = "음성2폴더" Then
        Cells(135= 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(45)
i_ppt_file = i_sheet.Cells(55)
    
    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(85)
i_col_txt_2 = i_sheet.Cells(95)
i_col_img_1 = i_sheet.Cells(105)
 
Dim i_img_top, i_img_left, i_img_size As Integer
 
i_img_top = i_sheet.Cells(117)
i_img_left = i_sheet.Cells(118)
i_img_size = i_sheet.Cells(119)
 
Dim i_folder_mp3_1, i_folder_mp3_2 As String
 
i_folder_mp3_1 = i_sheet.Cells(125)
i_folder_mp3_2 = i_sheet.Cells(135)
 
 
'슬라이드에 엑셀 텍스트, 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, 10100)
            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