Join more powerpoint presentations into one new presentation keeping the originally slide-layout in Lotusscript

Question

I am working on a project that joins two or more pp presentations into one new presentation. The selection of the original pp presentations is in a webbased Lotus Notes xPage and after the submit, Lotusscript talkes to the OLE Powerpoint object. Adding the slides into the new Presentation in the right order is no problem. The problem is that after the adding the original connection with the slides Template(s) is lost.

To solve this I found the next codesnippet:

Sub joiner()
 Dim sFileName As String
 Dim oDonor As Variant
 Dim otarget As Variant
 Dim i As Integer
 On Error GoTo errhandler

 Set otarget = ActivePresentation

 Do While sFileName <> ""
 Set oDonor = Presentations.Open(Environ("USERPROFILE") & "\Desktop\joiner\" &     sFileName, msoFalse)

 For i = 1 To oDonor.Slides.Count
 oDonor.Slides(i).Copy

 With otarget.Slides.Paste(otarget.Slides.Count + 1)
 .Design = oDonor.Slides(i).Design
 .ColorScheme = oDonor.Slides(i).ColorScheme
 End With

 Next i

 oDonor.Close
 Set oDonor = Nothing
 sFileName = Dir()
 Loop

 End Sub

I have to declare the presentations oDonor and oTarget as a Variant because lotusscript doesn't understand Dim oTarget As Presentation

This is probably the reason why the code returns a typemismatch error at: .Design = oDonor.Slides(i).Design

My questions are:

Am I doing the join the right way or is there a better solution?
Is there a solution for the typemismatch error?

*ps: The result presentation doesn't have to be editable, so maybe it is not necessary to add templates.

Update 04-10-2012: The next code solves the template problem. What still is missing now is the background image used by some slides. See: https://stackguides.com/questions/12731691/how-to-export-a-backgroundimage-of-a-slide-to-the-filesystem

Dim oDonor As Variant
Dim h As Integer
Dim thetmplt As Variant
Dim thetmpltname As String
Dim thetmpltnew As Variant
Dim thetmpltnamenew As String

Set oDonor = PPApplication.Presentations.Open(tempdirectory +
jobid+CStr(filenamearray  (i)),False,False,False)

thetmplt = oDonor.TemplateName  
Call oDonor.SaveAs(tempdirectory +jobid+CStr(i)+ thetmplt+".pot" ,5, -1)

For h = 1 To oDonor.Slides.Count

Dim oTargetSlide As Variant         

oDonor.Slides(h).Copy
Set oTargetSlide =  newPres.Slides.Paste()


Next        

Dim theubound As Variant
theubound = oDonor.Slides.Count
ReDim thearray(1 To k + theubound) As Variant


For k = k To k + oDonor.Slides.Count-1

thearray(k) = k
Next

Call newPres.Slides.Range(thearray()).ApplyTemplate(tempdirectory +
jobid+CStr(i+thetmplt+".pot")

oDonor.Close
Set oDonor = Nothing

Steve Rindsberg Steve Rindsberg · Accepted Answer · 2012-10-01T14:03:42

This is just a hunch, but try:

Dim oTargetSlide as Variant
Set oTargetSlide =  otarget.Slides.Paste(otarget.Slides.Count + 1)(1)
With oTargetSlide
 .Design = oDonor.Slides(i).Design
 .ColorScheme = oDonor.Slides(i).ColorScheme
 End With

Join more powerpoint presentations into one new presentation keeping the originally slide-layout in Lotusscript

1 Answers