VBA for merging 2 PPTX files alternatively

sksanjeev786

Well-known Member
Joined
Aug 5, 2020
Messages
883
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
Hi Team,

I have 2 PPTX files and each PPTX file has almost 100+ slides so i would like to merge them alternatively

i.e Amount 2 PPT X File "A"PPTX already has 100 slides and "B"PPTX also have 100 Slides.

"A" PPTX slides are the first points and "B" PPTX slides are the continuation of A but the current is separately

so i would like to merge all slides in "A" Consider as "A1 as page 1 and B1 as page 1 from "B" file (ie. A1,B1,A2,B2,A3,B3,A4,B4 etc)

So overall it will be 200 pages alternatively.

Can anyone help me with this?

Regards
Sanjeev
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Hello Sanjeev,

Do you need to run VBA, or can you use another program such as Python or PowerShell?

Regards,
Chris
 
Upvote 0
Hi Sanjeev,

Let's try this code. Obviously, you need to make sure PowerPoint is configured to allow Macros to run. You will need to update the file paths for 'FileA.pptx', 'FileB.pptx', and 'MergedFile.pptx' to match the actual file paths on your computer.

The code provided takes two PowerPoint files, each containing 100+ slides, and merges them together in an alternating fashion with the slide names reflecting the alternating pattern (A1, B1, A2, B2, A3, B3, etc.).

The code opens the first PowerPoint file (File A) and the second PowerPoint file (File B). It then inserts slides from File B into File A in an alternating fashion, and adds a prefix to the slide names to reflect the alternating pattern.

For example, the first slide from File A will be renamed to "A1", the first slide from File B will be renamed to "B2", the second slide from File A will be renamed to "A3", the second slide from File B will be renamed to "B4", and so on.

The code then saves the merged PowerPoint file as a new file called "MergedFile.pptx" and closes both files. Finally, it cleans up any objects used in the code.

Note that the notes added to the slides indicate which file the original slide came from and what its original slide number was, but the slide names themselves are renamed with the prefix reflecting the alternating pattern.

Let me know if you get any errors.

Good luck!
Chris


VBA Code:
Sub MergePPTX()

    Dim PPT1 As Presentation
    Dim PPT2 As Presentation
    Dim SlideA As Slide
    Dim SlideB As Slide
    Dim i As Integer
    
    'Open the first PowerPoint file
    Set PPT1 = Presentations.Open("C:\Path\To\FileA.pptx")
    
    'Open the second PowerPoint file
    Set PPT2 = Presentations.Open("C:\Path\To\FileB.pptx")
    
    'Insert slides from the second file into the first file in alternating fashion
    For i = 1 To PPT2.Slides.Count
        Set SlideB = PPT2.Slides(i)
        Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, SlideB.Layout)
        SlideB.Copy
        SlideA.Shapes.Paste
        Set SlideB = Nothing
        Set SlideA = Nothing
        Set SlideA = PPT1.Slides(PPT1.Slides.Count)
        SlideA.Name = "A" & CStr((i * 2) - 1)
        SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File A"
        If i < PPT2.Slides.Count Then
            Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, PpSlideLayout.ppLayoutTitleOnly)
            SlideA.Name = "B" & CStr(i * 2)
            SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File B"
            Set SlideB = PPT2.Slides(i + 1)
            SlideB.Copy
            SlideA.Shapes.Paste
            Set SlideB = Nothing
            Set SlideA = Nothing
        End If
    Next i
    
    'Save the merged PowerPoint file
    PPT1.SaveAs "C:\Path\To\MergedFile.pptx"
 
Upvote 0
Hi Sanjeev,

Let's try this code. Obviously, you need to make sure PowerPoint is configured to allow Macros to run. You will need to update the file paths for 'FileA.pptx', 'FileB.pptx', and 'MergedFile.pptx' to match the actual file paths on your computer.

The code provided takes two PowerPoint files, each containing 100+ slides, and merges them together in an alternating fashion with the slide names reflecting the alternating pattern (A1, B1, A2, B2, A3, B3, etc.).

The code opens the first PowerPoint file (File A) and the second PowerPoint file (File B). It then inserts slides from File B into File A in an alternating fashion, and adds a prefix to the slide names to reflect the alternating pattern.

For example, the first slide from File A will be renamed to "A1", the first slide from File B will be renamed to "B2", the second slide from File A will be renamed to "A3", the second slide from File B will be renamed to "B4", and so on.

The code then saves the merged PowerPoint file as a new file called "MergedFile.pptx" and closes both files. Finally, it cleans up any objects used in the code.

Note that the notes added to the slides indicate which file the original slide came from and what its original slide number was, but the slide names themselves are renamed with the prefix reflecting the alternating pattern.

Let me know if you get any errors.

Good luck!
Chris


VBA Code:
Sub MergePPTX()

    Dim PPT1 As Presentation
    Dim PPT2 As Presentation
    Dim SlideA As Slide
    Dim SlideB As Slide
    Dim i As Integer
  
    'Open the first PowerPoint file
    Set PPT1 = Presentations.Open("C:\Path\To\FileA.pptx")
  
    'Open the second PowerPoint file
    Set PPT2 = Presentations.Open("C:\Path\To\FileB.pptx")
  
    'Insert slides from the second file into the first file in alternating fashion
    For i = 1 To PPT2.Slides.Count
        Set SlideB = PPT2.Slides(i)
        Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, SlideB.Layout)
        SlideB.Copy
        SlideA.Shapes.Paste
        Set SlideB = Nothing
        Set SlideA = Nothing
        Set SlideA = PPT1.Slides(PPT1.Slides.Count)
        SlideA.Name = "A" & CStr((i * 2) - 1)
        SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File A"
        If i < PPT2.Slides.Count Then
            Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, PpSlideLayout.ppLayoutTitleOnly)
            SlideA.Name = "B" & CStr(i * 2)
            SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File B"
            Set SlideB = PPT2.Slides(i + 1)
            SlideB.Copy
            SlideA.Shapes.Paste
            Set SlideB = Nothing
            Set SlideA = Nothing
        End If
    Next i
  
    'Save the merged PowerPoint file
    PPT1.SaveAs "C:\Path\To\MergedFile.pptx"
Hi Chris,

Thank you so much for your hard work on this.

I have tried to run the macro but getting error.

>> Basically i have open FileA and File B (Both files are open) (Macro copied in (File A module) but getting errror even i have treid to creat MergeFile but still getting error.
I belive Mergedfile create automatically.

1678961097510.png
 
Upvote 0
Hi Sanjeev,

You're welcome! The pleasure is all mine.

I believe the error comes from not properly closing the "End If" statement. I just realized I didn't include the rest of the code. That's my fault, sorry!

Here is the complete code for your use.



VBA Code:
Sub MergePPTX()

    Dim PPT1 As Presentation
    Dim PPT2 As Presentation
    Dim SlideA As Slide
    Dim SlideB As Slide
    Dim i As Integer
    
    'Open the first PowerPoint file
    Set PPT1 = Presentations.Open("C:\Path\To\FileA.pptx")
    
    'Open the second PowerPoint file
    Set PPT2 = Presentations.Open("C:\Path\To\FileB.pptx")
    
    'Insert slides from the second file into the first file in alternating fashion
    For i = 1 To PPT2.Slides.Count
        Set SlideB = PPT2.Slides(i)
        Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, SlideB.Layout)
        SlideB.Copy
        SlideA.Shapes.Paste
        Set SlideB = Nothing
        Set SlideA = Nothing
        Set SlideA = PPT1.Slides(PPT1.Slides.Count)
        SlideA.Name = "A" & CStr((i * 2) - 1)
        SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File A"
        If i < PPT2.Slides.Count Then
            Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, PpSlideLayout.ppLayoutTitleOnly)
            SlideA.Name = "B" & CStr(i * 2)
            SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File B"
            Set SlideB = PPT2.Slides(i + 1)
            SlideB.Copy
            SlideA.Shapes.Paste
            Set SlideB = Nothing
            Set SlideA = Nothing
        End If
    Next i
    
    'Save the merged PowerPoint file
    PPT1.SaveAs "C:\Path\To\MergedFile.pptx"
    
    'Close both files
    PPT1.Close
    PPT2.Close
    
    'Clean up objects
    Set PPT1 = Nothing
    Set PPT2 = Nothing

End Sub
 
Upvote 0
Hi Sanjeev,

You're welcome! The pleasure is all mine.

I believe the error comes from not properly closing the "End If" statement. I just realized I didn't include the rest of the code. That's my fault, sorry!

Here is the complete code for your use.



VBA Code:
Sub MergePPTX()

    Dim PPT1 As Presentation
    Dim PPT2 As Presentation
    Dim SlideA As Slide
    Dim SlideB As Slide
    Dim i As Integer
   
    'Open the first PowerPoint file
    Set PPT1 = Presentations.Open("C:\Path\To\FileA.pptx")
   
    'Open the second PowerPoint file
    Set PPT2 = Presentations.Open("C:\Path\To\FileB.pptx")
   
    'Insert slides from the second file into the first file in alternating fashion
    For i = 1 To PPT2.Slides.Count
        Set SlideB = PPT2.Slides(i)
        Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, SlideB.Layout)
        SlideB.Copy
        SlideA.Shapes.Paste
        Set SlideB = Nothing
        Set SlideA = Nothing
        Set SlideA = PPT1.Slides(PPT1.Slides.Count)
        SlideA.Name = "A" & CStr((i * 2) - 1)
        SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File A"
        If i < PPT2.Slides.Count Then
            Set SlideA = PPT1.Slides.Add(PPT1.Slides.Count + 1, PpSlideLayout.ppLayoutTitleOnly)
            SlideA.Name = "B" & CStr(i * 2)
            SlideA.NotesPage.Shapes.Placeholders.Item(2).TextFrame.TextRange.Text = "Slide " & PPT1.Slides.Count & " from File B"
            Set SlideB = PPT2.Slides(i + 1)
            SlideB.Copy
            SlideA.Shapes.Paste
            Set SlideB = Nothing
            Set SlideA = Nothing
        End If
    Next i
   
    'Save the merged PowerPoint file
    PPT1.SaveAs "C:\Path\To\MergedFile.pptx"
   
    'Close both files
    PPT1.Close
    PPT2.Close
   
    'Clean up objects
    Set PPT1 = Nothing
    Set PPT2 = Nothing

End Sub

Hi Chris,
Good Morning:)

Thank you again for your hard work on this :)

Just now i have check with the Macro and looks like i am able to run the macro but Slides are not coming in Alternative wise

After running via Macor i am getting all File A slides in a row and File B slides in Image format in a row but not in Alternative wise
Below is the Screenshot for your ref..

Thanks in advance :)

1679063376899.png
 
Upvote 0
Just so I'm clear, in the new PPTX file, all of the File A slides are at the beginning, in sequential order, and then all of the File B slides are at the end?
 
Upvote 0
Just so I'm clear, in the new PPTX file, all of the File A slides are at the beginning, in sequential order, and then all of the File B slides are at the end?
Hi Chris,

In new PPTX all the slides from File A are at the beginning in sequence order and after that File B slides but there are all in image format.
 
Upvote 0

Forum statistics

Threads
1,214,951
Messages
6,122,449
Members
449,083
Latest member
Ava19

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top