|
VBA合并多个PPT文档
Private Sub UserForm_Click()
Dim path As String
Dim inputFileName As String
Dim outputFileName As String
Dim slideNum As Integer
path = "d:\works"
outputFileName = "allinone.ppt"
Set pptApp = New PowerPoint.Application
pptApp.Visible = msoTrue
Set pptOutput = pptApp.Presentations.Open("d:\" & outputFileName)
If pptOutput.Slides.Count = 0 Then
Set newSlide = pptOutput.Slides.Add(1, ppLayoutBlank)
End If
FileNames = Array("047-3.ppt", "048-1.ppt", "048-2.ppt", "048-3.ppt", "049-1.ppt", "049-2.ppt", "049-3.ppt", "050-1.ppt", "050-2.ppt", "050-3.ppt", "051-1.ppt", "051-2.ppt", "051-3.ppt", "052-1.ppt", "052-2.ppt", "052-3.ppt", "053-1.ppt", "053-2.ppt", "053-3.ppt", "054-1.ppt", "054-2.ppt", "054-3.ppt")
For k = 0 To 21
FileName = path & "\" & FileNames(k)
Debug.Print FileName
Set pptInput = pptApp.Presentations.Open(FileName)
For j = 1 To pptInput.Slides.Count
pptInput.Slides(j).Copy
pptOutput.Slides.Paste (pptOutput.Slides.Count)
Next j
pptInput.Close
pptOutput.Save
Next k
pptOutput.Close
End Sub
|
