Programmatically combine slides from multiple presentations into a single presentation

Question

I need to automate the creation of a presentation (either OpenOffice or Powerpoint). The presentation should take the first two slides of each of the presentations in a given directory, and then combine them into a single presentation. I'm confused as to what approach I should take to solve this. Any pointers will be appreciated.

Ahumada

Answer 1

Talking about PowerPoint, you would use a VBA Macro to do the job, something like

Sub Pull()
Dim SrcDir As String, SrcFile As String

    SrcDir = PickDir()
    If SrcDir = "" Then Exit Sub

    SrcFile = Dir(SrcDir & "\*.ppt")

    Do While SrcFile <> ""
        ImportFromPPT SrcDir + "\" + SrcFile, 1, 2
        SrcFile = Dir()
    Loop

End Sub

Selecting your source directory you can use this function

Private Function PickDir() As String
Dim FD As FileDialog

    PickDir = ""

    Set FD = Application.FileDialog(msoFileDialogFolderPicker)
    With FD
        .Title = "Pick a directory to work on"
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count <> 0 Then
            PickDir = .SelectedItems(1)
        End If
    End With

End Function

Now - the main point is inserting slides from another PPT while preserving the source format. This is a tricky thing, as the PPT VBA InsertFromFile method is of no good use. Microsoft gave us good time to figure it out the hard way in countless 20hrs debuging sessions :-) and you need to type a lot of code to get it done correctly - far more complicated than using the dialogue manually, in particular if your source slide deviates from your source master slide.

If your PPT's are sticking to their masters, you can safely omit all code between the ">>>>"

Private Sub ImportFromPPT(FileName As String, SlideFrom As Long, SlideTo As Long)
Dim SrcPPT As Presentation, SrcSld As Slide, Idx As Long, SldCnt As Long

    Set SrcPPT = Presentations.Open(FileName, , , msoFalse)
    SldCnt = SrcPPT.Slides.Count

    If SlideFrom > SldCnt Then Exit Sub
    If SlideTo > SldCnt Then SlideTo = SldCnt

    For Idx = SlideFrom To SlideTo Step 1
        Set SrcSld = SrcPPT.Slides(Idx)
        SrcSld.Copy
        With ActivePresentation.Slides.Paste
            .Design = SrcSld.Design
            .ColorScheme = SrcSld.ColorScheme
            ' if slide is not following its master (design, color scheme)
            ' we must collect all bits & pieces from the slide itself

            ' >>>>>>>>>>>>>>>>>>>>

            If SrcSld.FollowMasterBackground = False Then
                .FollowMasterBackground = False
                .Background.Fill.Visible = SrcSld.Background.Fill.Visible
                .Background.Fill.ForeColor = SrcSld.Background.Fill.ForeColor
                .Background.Fill.BackColor = SrcSld.Background.Fill.BackColor

                ' inspect the FillType object
                Select Case SrcSld.Background.Fill.Type
                    Case Is = msoFillTextured
                        Select Case SrcSld.Background.Fill.TextureType
                        Case Is = msoTexturePreset
                            .Background.Fill.PresetTextured (SrcSld.Background.Fill.PresetTexture)
                        Case Is = msoTextureUserDefined
                        ' TextureName gives a filename w/o path
                        ' not implemented, see picture handling
                        End Select

                    Case Is = msoFillSolid
                        .Background.Fill.Transparency = 0#
                        .Background.Fill.Solid

                    Case Is = msoFillPicture
                        ' picture cannot be copied directly, need to export and re-import slide image
                        If SrcSld.Shapes.Count > 0 Then SrcSld.Shapes.Range.Visible = False
                        bMasterShapes = SrcSld.DisplayMasterShapes
                        SrcSld.DisplayMasterShapes = False
                        SrcSld.Export SrcPPT.Path & SrcSld.SlideID & ".png", "PNG"

                        .Background.Fill.UserPicture SrcPPT.Path & SrcSld.SlideID & ".png"
                        Kill (SrcPPT.Path & SrcSld.SlideID & ".png")

                        SrcSld.DisplayMasterShapes = bMasterShapes
                        If SrcSld.Shapes.Count > 0 Then SrcSld.Shapes.Range.Visible = True

                    Case Is = msoFillPatterned
                        .Background.Fill.Patterned (SrcSld.Background.Fill.Pattern)

                    Case Is = msoFillGradient

                        ' inspect gradient type
                        Select Case SrcSld.Background.Fill.GradientColorType
                        Case Is = msoGradientTwoColors
                            .Background.Fill.TwoColorGradient
                                SrcSld.Background.Fill.GradientStyle , _
                                SrcSld.Background.Fill.GradientVariant
                        Case Is = msoGradientPresetColors
                            .Background.Fill.PresetGradient _
                                SrcSld.Background.Fill.GradientStyle, _
                                SrcSld.Background.Fill.GradientVariant, _
                                SrcSld.Background.Fill.PresetGradientType
                        Case Is = msoGradientOneColor
                            .Background.Fill.OneColorGradient _
                                SrcSld.Background.Fill.GradientStyle, _
                                SrcSld.Background.Fill.GradientVariant, _
                                SrcSld.Background.Fill.GradientDegree
                        End Select

                    Case Is = msoFillBackground
                        ' Only shapes - we shouldn't come here
                End Select
            End If

            ' >>>>>>>>>>>>>>>>>>>>

        End With
    Next Idx

End Sub

The code doesn't check for read-only or password protected fies and will crash on them. Also be careful not to run over the collector file itself. Otherwise it should work. I must admit I haven't reviewed the code for a long time ;-)

Protuberance

Thank you! That was exactly what I was looking for. I only had to make a minor change in loop of the Pull method: ImportFromPPT SrcDir + "\" + SrcFile, 1, 2 SrcFile = Dir – Ahumada

ahhh correct ... I forgot to update the thread ... sorry; as you see there's a bit of abstraction here, if next time you need to pull slides 5-7 you can reuse the same ;-) – Protuberance

Don't you need to close the source PPT files after you've grabbed the slides? – Affinitive

Answer 2

You can google "powerpoint join" to find a useful tool to join many ppts.

Beneficiary

Answer 3

I'm glad @miked was able to get you what you needed.

Another method to consider, if using .NET, is discussed in this post

Embolic

Answer 4

A simple and fast solution:

I := Presentation.Slides.InsertFromFile(FileName,X,StartSlideNo,EndSlideNo);
Presentation.Slides.Item(I).ApplyTheme(FileName);
Presentation.Slides.Item(I).ApplyTemplate(FileName);

Note: X is place to insert slide in presentation

I is actual place where slide was inserted

Code is written in Delphi/Pascal but you can convert it easelly ...

Fann

Answer 5

You can do this with Aspose.Slides for .NET. It even allows joining OpenOffice and PowerPoint presentations together. View this article.

var presentation1 = new Presentation("presentation1.pptx");
var presentation2 = new Presentation("presentation2.odp");

var mergedPresentation = new Presentation();
while (mergedPresentation.Slides.Count > 0) mergedPresentation.Slides.RemoveAt(0);

// Adding two slides from the first PPTX presentation
mergedPresentation.Slides.AddClone(presentation1.Slides[0]);
mergedPresentation.Slides.AddClone(presentation1.Slides[1]);

// Adding two slides from the second OPD presentation
mergedPresentation.Slides.AddClone(presentation2.Slides[0]);
mergedPresentation.Slides.AddClone(presentation2.Slides[1]);

mergedPresentation.Save("mergedPresentation.pptx", SaveFormat.Pptx);

Sunnysunproof

I've decided to use GemBox.Presentation instead. See my question, the first answer shows how to join presentations together. – Error