Basically, I'm opening a number of different presentations, pulling
individual slides from these presentations into a new presentation, and
finally showing the new presentation in slidesorter view. Here is all
the code:
Sub BuildPresentation()
'Dim pp As PowerPoint.Application
Dim pp As Object
Dim pres1 As PowerPoint.Presentation
Dim pres2 As PowerPoint.Presentation
Dim ppSlides As PowerPoint.Slides
Dim ppSlide As PowerPoint.Slide
Dim newSlide As PowerPoint.Slide
Dim cnt As Integer
Dim i, index, j As Integer
Dim tmp As String
Dim slide As String
Dim num1, num2
Dim oldGatefold, newGatefold As String
Try
'Create a powerpoint object
pp = CreateObject("PowerPoint.Application")
'pp.WindowState = PowerPoint.PpWindowState.ppWindowMinimized
pp.Visible = Office.MsoTriState.msoTrue
pp.WindowState = PowerPoint.PpWindowState.ppWindowMinimized
Application.DoEvents()
Catch ex As Exception
MsgBox("Error opening powerpoint. Error is: " & ex.ToString)
Me.Close()
Exit Sub
End Try
Try
'We have to open this template file so the slides we pull
out
'will have the correct templated scheme
pres2 =
pp.Presentations.Open("C:\DATA\Powerpnt\caps\_tmp. pot")
Catch ex As Exception
MsgBox("Error opening Powerpoint template. Error is: " &
ex.ToString)
Me.Close()
Exit Sub
End Try
'Keep form on top
Me.TopMost = True
Application.DoEvents()
pb1.Maximum = progCnt
lblProgress.Text = "Building Presentation. Please wait..."
' MsgBox("Starting build")
Try
'Slides can be in a number of different gatefolds (different
ppt presentations.
'We cycle through and pull out the slides for each gatefold
and add them
'to a new presentation.
For i = 1 To UBound(arrGateFolds)
tmp = arrGateFolds(i)
pb1.Value = i 'increment progress bar
' MsgBox("tmp: " & tmp)
Application.DoEvents()
If RTrim(tmp) = "" Then Exit For
'The entry will have a gatefold name, space, slide
number
'We need to separate them out
index = InStr(tmp, " ")
newGatefold = Mid(tmp, 1, index - 1)
'MsgBox("Gatefold: " & newGatefold)
slide = RTrim(Mid(tmp, index + 1, 20))
'MsgBox("slide: " & slide)
'If the gatefold name changes we need to close that
'presentation and open the new one.
If newGatefold <> oldGatefold Then
If Not IsNothing(pres1) Then pres1.Close()
pres1 = pp.Presentations.Open(newGatefold)
oldGatefold = newGatefold
End If
'try to pull out the desired slide
Try
ppSlide = pres1.Slides.Item(CInt(slide))
Catch ex As Exception
'must not exist so set slide to nothing
MsgBox("Error opening slide: " & newGatefold & " " &
slide)
ppSlide = Nothing
End Try
'copy and paste the slide to new presentation
If Not IsNothing(ppSlide) Then
pres1.Slides.Item(CInt(slide)).Copy()
pres2.Slides.Paste()
End If
Next
Catch ex As Exception
MsgBox("Error adding slides to new presentation. Error is: "
& ex.ToString)
pres1.Close()
pres2.Close()
pp.Quit()
Me.Close()
Exit Sub
End Try
'Let's delete the first slide as it is the template slide
pres2.Slides.Item(1).Delete()
pres2.SaveAs(ppFileName,
PowerPoint.PpSaveAsFileType.ppSaveAsDefault, Office.MsoTriState.msoTrue)
pp.Windows.Item(2).ViewType =
PowerPoint.PpViewType.ppViewSlideSorter
pres1.Close()
pres2.Save()
pres2.Saved = Office.MsoTriState.msoTrue
'Display that we have saved new presentation
lblProgress.Text = "Presentation saved as: " & ppFileName
Application.DoEvents()
t2.Enabled = True
While t2.Enabled = True
Application.DoEvents()
If t2.Enabled = False Then Exit While
'Just loop here a few seconds to show message.
End While
pp.WindowState = PowerPoint.PpWindowState.ppWindowMaximized
pp.Presentations.Item(1).Saved = Office.MsoTriState.msoTrue
End Sub
presentation names and a slide number is passed into the array.
Something like C:\ppt\sales.ppt 4 means pull the 4th slide out of
this presentation and paste it into the new one.
Thanks for taking the time to look at this.
Rut
*** Sent via Developersdex
http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
