How do I use excel VBA to insert blank slide every 5th slide

[BuJay]

Suppose I have 50 slides in a powerpoint.

I can create a macro that opens it....

How would I insert a new blank slide in front of first slide, and then a new blank slide after every 5 slides...

So end product would have 61 slides....as follows:

New1, Old1, Old2, Old3, Old4, Old5, New2, Old6, Old7, Old8, Old9, Old10, New3, .....etc.

 

[bferraz]

Hey, try this code:

Just remember to enable PowerPoint reference.

Sub PowerPointAddSlides()

Dim DestinationPPT As String
Dim counting As Double
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim pptLayout As CustomLayout

Set PowerPointApp = CreateObject("PowerPoint.Application")

DestinationPPT = "path" 'change to your path
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)

For i = 1 To 55 Step 5

Set pptLayout = myPresentation.Slides(1).CustomLayout
myPresentation.Slides.AddSlide (i + counting), pptLayout
counting = counting + 1

Next i

End Sub

 

[BuJay]

Hey, try this code:

Just remember to enable PowerPoint reference.

Sub PowerPointAddSlides()

Dim DestinationPPT As String
Dim counting As Double
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim pptLayout As CustomLayout

Set PowerPointApp = CreateObject("PowerPoint.Application")

DestinationPPT = "path" 'change to your path
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)

For i = 1 To 55 Step 5

Set pptLayout = myPresentation.Slides(1).CustomLayout
myPresentation.Slides.AddSlide (i + counting), pptLayout
counting = counting + 1

Next i

End Sub

Looks great. For some reason, it is inserting a slide with a Click to add title box and a Click to add subtitle box. Is there a way to prevent the subtitle box from appearing? I can actually use the Title box!

 

[BuJay]

or better yet, maybe keep the subtitle box but add a date in this form? As of December 31, 2022 with the date coded into the vba as a macro variable?

 

[bferraz]

Here is the update:

Sub PowerPointAddSlides()

Dim DestinationPPT As String
Dim counting As Double
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim pptLayout As CustomLayout
Dim shp As PowerPoint.Shape

Set PowerPointApp = CreateObject("PowerPoint.Application")

DestinationPPT = "path" 'change to your path
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)

For i = 1 To 55 Step 5

Set pptLayout = myPresentation.Slides(1).CustomLayout
myPresentation.Slides.AddSlide (i + counting), pptLayout

For Each shp In myPresentation.Slides(i + counting).Shapes
If InStr(1, shp.Name, "Subtitle") Then shp.TextFrame.TextRange.Text = "December 31, 2022" 'your custom text
Next shp

counting = counting + 1

Next i

End Sub

 

[BuJay]

Here is the update:

Sub PowerPointAddSlides()

Dim DestinationPPT As String
Dim counting As Double
Dim PowerPointApp As PowerPoint.Application
Dim myPresentation As PowerPoint.Presentation
Dim pptLayout As CustomLayout
Dim shp As PowerPoint.Shape

Set PowerPointApp = CreateObject("PowerPoint.Application")

DestinationPPT = "path" 'change to your path
Set myPresentation = PowerPointApp.Presentations.Open(DestinationPPT)

For i = 1 To 55 Step 5

Set pptLayout = myPresentation.Slides(1).CustomLayout
myPresentation.Slides.AddSlide (i + counting), pptLayout

For Each shp In myPresentation.Slides(i + counting).Shapes
If InStr(1, shp.Name, "Subtitle") Then shp.TextFrame.TextRange.Text = "December 31, 2022" 'your custom text
Next shp

counting = counting + 1

Next i

End Sub

Awesome! Thank you!