Great script, but what about source format?

[Kallamamran]

I've merged 27 pptx-files with success and with a big smile on my lips only to notice it doesn't take into account the source formatting. Damn... I thought I'd find the perfect solution since this worked soooooo good and was so fast. I really thought I'd save a lot of time with this...

Any plans or suggestions on how to activate source formatting for all merged PPTX-files?

Best regards // Johan

[birbilis]

Hi, can you provide a zip with a sample case? (some small PPTs)
Do you mean source style?

[birbilis]

The code that inserts the slides is here:
https://github.com/Zoomicon/tranXform/blob/master/src/PPTmerge/PPTmerge.vbs#L48

it does:

Sub ProcessFile(filename)
 outppt.Slides.InsertFromFile filename, outppt.Slides.Count 'Insert at the end (append)
End Sub

aka it calls https://docs.microsoft.com/en-us/office/vba/api/powerpoint.slides.insertfromfile
the syntax of which is:

expression. InsertFromFile( FileName, Index, SlideStart, SlideEnd )
expression A variable that represents a Slides object.

A question is, does PowerPoint allow you to manually do the operation (say with two PPTs) and get the result in the way you expect? If it does, then I can easily guide you into recording a macro and we can check out what VBA code that macro generates

---

If you mean that all the concatenated result uses some style from the 1st powerpoint document (into which the rest are inserted to produce a new file), then I remember I had a similar issue with Word which resulted in a different insertion strategy (via copy and special paste):

https://github.com/Zoomicon/tranXform/blob/master/src/DOCmerge/DOCmerge.vbs#L49

Sub ProcessFile(filename, insertBreak)
 Dim doc
 Set doc = word.Documents.Open(filename)
 word.Selection.WholeStory
 word.Selection.Copy
 outdoc.Activate
 if insertBreak then word.Selection.InsertBreak wdPageBreak
 'word.Selection.PasteAndFormat wdPasteDefault
 word.Selection.Paste 'use this one so that it works for Word2000 too
 doc.Close
 Set doc = Nothing
End Sub

maybe we could try the same or similar logic there, say something like:

Sub ProcessFile(filename)
 Dim ppt
 Set ppt = powerpoint.Presentations.Open(filename)
 ppt.Selection.WholeStory
 ppt.Selection.Copy
 outppt.Activate
 ppt.Selection.Paste
 ppt.Close
 Set ppt = Nothing
End Sub

if that doesn't work we can try the macro recording route I was speaking about above to see what code is generated when you copy-paste slides from one presentation to another

[Kallamamran]

I mean this check mark when running "Reuse Slides". Without it it unfortunately doesn't take into account the formatting of the slides it is importing.

[birbilis]

Unfortunately the macro recorder (which was quite a handy tool) has been removed from PP2013 and up. What version of PowerPoint are you using?

The macro recorder, used to automate frequent tasks, is not available in PowerPoint 2013 or newer versions. Instead, you can use Visual Basic for Applications (VBA) to create or edit macros. This includes editing those that were created in earlier versions of PowerPoint.

https://support.microsoft.com/en-us/office/create-a-macro-in-powerpoint-5b07aff6-4dc9-462f-8fc9-66b4c5344e7e?ui=en-us&rs=en-us&ad=us&fromar=1

[Kallamamran]

Just noticed :'(
Enabled "developer", but no macro recorder.
I'm using O365 (PowerPoint for Office 365MSO (16.0.11929.20436) 32-bit

[Kallamamran]

Tried changing the code in the VBS-file for Sub ProcessFile(filename) to the example code for similar logic from above, but it didn't work.

[birbilis]

I did find related discussion and some promising code that could be adapted to VBA

[Kallamamran]

Will check that out.
I tried CTRL-C, CTRL-V with slides from one presentation to another, but then it also discards the source format and uses the format of the presentation where it is pasted. Not good!

[Kallamamran]

Wow... Good information but i don't think, me coding this will save any time at all :'D

[birbilis]

Will try adapting on the fly that code sample below, hope I don't do any mistakes...

[birbilis]

let's see:

Sub ProcessFile(filename)
  Dim ppt
  Set oSource = powerpoint.Presentations.Open(filename)
  Dim oTarget 
  Set oTarget = outppt
  Dim oSlide
  Dim bMasterShapes

  For Each oSlide In oSource.Slides
    oSlide.Copy
    With oTarget.Slides.Paste
        .Design = oSlide.Design
       
        ' Apply the color scheme only after you have applied
	' the design, else it won't give the desired results.
        .ColorScheme = oSlide.ColorScheme
       
        ' Additional processing for slides which don't follow
        ' the master background
        If oSlide.FollowMasterBackground = False Then
            .FollowMasterBackground = False
            With .Background.Fill
		.Visible = oSlide.Background.Fill.Visible
                .ForeColor = oSlide.Background.Fill.ForeColor
                .BackColor = oSlide.Background.Fill.BackColor
            End With

            Select Case oSlide.Background.Fill.Type
            
              Case Is = msoFillTextured

                Select Case oSlide.Background.Fill.TextureType

                  Case Is = msoTexturePreset
     		      .Background.Fill.PresetTextured (oSlide.Background.Fill.PresetTexture)

                  Case Is = msoTextureUserDefined
                     ' TextureName gives only the filename and 
	             ' not the path to the custom texture file used.
                     ' We could do it the same way we handle picture fill.
                End Select

              Case Is = msoFillSolid
		.Background.Fill.Transparency = 0#
                .Background.Fill.Solid
  
            Case Is = msoFillPicture
               
		' No way to get the picture so export the slide image.
                With oSlide
                    If .Shapes.Count>0 Then .Shapes.Range.Visible=False
                    
                    bMasterShapes = .DisplayMasterShapes
		                   
		    .DisplayMasterShapes = False
                    .Export oSource.Path & .SlideID &  ".png", "PNG"
                End With

                .Background.Fill.UserPicture oSource.Path & oSlide.SlideID & ".png"

                Kill (oSource.Path & oSlide.SlideID & ".png")
    
                With oSlide
                    .DisplayMasterShapes = bMasterShapes
                    If .Shapes.Count>0 Then .Shapes.Range.Visible= True
		End With

            Case Is = msoFillPatterned
                  .Background.Fill.Patterned (oSlide.Background.Fill.Pattern)
 
           Case Is = msoFillGradient

                Select Case oSlide.Background.Fill.GradientColorType

                  Case Is = msoGradientTwoColors
                    .Background.Fill.TwoColorGradient oSlide.Background.Fill.GradientStyle, _
     		       oSlide.Background.Fill.GradientVariant

                Case Is = msoGradientPresetColors
                    .Background.Fill.PresetGradient oSlide.Background.Fill.GradientStyle, _
		        oSlide.Background.Fill.GradientVariant, _
		        oSlide.Background.Fill.PresetGradientType

                Case Is = msoGradientOneColor
                    .Background.Fill.OneColorGradient _
   		        oSlide.Background.Fill.GradientStyle, _
		        oSlide.Background.Fill.GradientVariant, _
		        oSlide.Background.Fill.GradientDegree
                End Select
   
         Case Is = msoFillBackground
                ' Only applicable to shapes.
            End Select
        End If
End With
Next oSlide

oSource.Close

Set oSource = Nothing
Set oTarget = Nothing
Set oSlide = Nothing
End Sub

[birbilis]

did some more formatting above, let me know if you try it out. Probably it works in newer VBA only (since I see With being used), although one could adapt it for older VBA too if it doesn't support With by using variables with Dim x / Set x=... / Set x=Nothing and use x.something instead of .something at those statements inside with blocks

[birbilis]

probably you could remove some parts and just keep

        .Design = oSlide.Design
       
        ' Apply the color scheme only after you have applied
	' the design, else it won't give the desired results.
        .ColorScheme = oSlide.ColorScheme

[birbilis]

Btw, found another interesting discussion with C# code sample (with many broken links in it afaik) that may have some extra workarrounds for specific lost-styling issues during the programmatic copy-pasting of slides.

That is if one wanted to build a bullet-proof PPT merging tool. My original usecase was to merge presentations that had all been authored based on the same source powerpoint so that they could be presented in a certain order all together.

[Kallamamran]

I should only replace the section "Sub ProcessFile(filename)" right...

I get an error dropping the folder of PPTX-files on there

[birbilis]

it says syntax error at that line/col, what code is there at that line now that you changed the file?

[birbilis]

did you have any progress? I'd suggest first trying a smaller version of the proc:

Sub ProcessFile(filename)
  Dim ppt
  Set oSource = powerpoint.Presentations.Open(filename)
  Dim oTarget 
  Set oTarget = outppt
  Dim oSlide
  Dim bMasterShapes

  For Each oSlide In oSource.Slides
    oSlide.Copy
    With oTarget.Slides.Paste
        .Design = oSlide.Design
       
        ' Apply the color scheme only after you have applied
	' the design, else it won't give the desired results.
        .ColorScheme = oSlide.ColorScheme
    End With
Next oSlide

oSource.Close

Set oSource = Nothing
Set oTarget = Nothing
Set oSlide = Nothing
End Sub

or even better without the "with" which might not be supported in VBScript that one runs from the command-line (but only in VBA for marcros running inside Office that is)

Sub ProcessFile(filename)
  Dim ppt
  Set oSource = powerpoint.Presentations.Open(filename)
  Dim oTarget 
  Set oTarget = outppt
  Dim oSlide
  Dim bMasterShapes

  Dim paste
  For Each oSlide In oSource.Slides
    oSlide.Copy
    Set paste = oTarget.Slides.Paste
    
    paste.Design = oSlide.Design
       
    ' Apply the color scheme only after you have applied
    ' the design, else it won't give the desired results.
    paste.ColorScheme = oSlide.ColorScheme
  Next oSlide
  Set paste = Nothing

oSource.Close

Set oSource = Nothing
Set oTarget = Nothing
Set oSlide = Nothing
End Sub