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 BuildPresentati on()
'Dim pp As PowerPoint.Appl ication
Dim pp As Object
Dim pres1 As PowerPoint.Pres entation
Dim pres2 As PowerPoint.Pres entation
Dim ppSlides As PowerPoint.Slid es
Dim ppSlide As PowerPoint.Slid e
Dim newSlide As PowerPoint.Slid e
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("P owerPoint.Appli cation")
'pp.WindowState = PowerPoint.PpWi ndowState.ppWin dowMinimized
pp.Visible = Office.MsoTriSt ate.msoTrue
pp.WindowState = PowerPoint.PpWi ndowState.ppWin dowMinimized
Application.DoE vents()
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.Presentation s.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.DoE vents()
pb1.Maximum = progCnt
lblProgress.Tex t = "Building Presentation. Please wait..."
' MsgBox("Startin g 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(arrGateF olds)
tmp = arrGateFolds(i)
pb1.Value = i 'increment progress bar
' MsgBox("tmp: " & tmp)
Application.DoE vents()
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("Gatefo ld: " & 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.Presentation s.Open(newGatef old)
oldGatefold = newGatefold
End If
'try to pull out the desired slide
Try
ppSlide = pres1.Slides.It em(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(ppSli de) Then
pres1.Slides.It em(CInt(slide)) .Copy()
pres2.Slides.Pa ste()
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.It em(1).Delete()
pres2.SaveAs(pp FileName,
PowerPoint.PpSa veAsFileType.pp SaveAsDefault, Office.MsoTriSt ate.msoTrue)
pp.Windows.Item (2).ViewType =
PowerPoint.PpVi ewType.ppViewSl ideSorter
pres1.Close()
pres2.Save()
pres2.Saved = Office.MsoTriSt ate.msoTrue
'Display that we have saved new presentation
lblProgress.Tex t = "Presentati on saved as: " & ppFileName
Application.DoE vents()
t2.Enabled = True
While t2.Enabled = True
Application.DoE vents()
If t2.Enabled = False Then Exit While
'Just loop here a few seconds to show message.
End While
pp.WindowState = PowerPoint.PpWi ndowState.ppWin dowMaximized
pp.Presentation s.Item(1).Saved = Office.MsoTriSt ate.msoTrue
End Sub
presentation names and a slide number is passed into the array.
Something like C:\ppt\sales.pp t 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!
