Copy slide based on specific words to new presentation

Question

I have a master PowerPoint presentation that has ~60 slides.

I want to go through the entire deck and copy specific slides that have certain text. I can create an array with the key words that form the basis of the selection but cannot figure out how to copy the entire slide.

Below code is the result of foraging on the internet.

Sub selct()

Dim pres1 As PowerPoint.Presentation, pres2 As PowerPoint.Presentation, 
pp  As Object
Set pp = GetObject(, "PowerPoint.Application")

Set pres1 = pp.ActivePresentation
Set pres2 = pp.Presentations.Add

Dim i As Long, n As Long
Dim TargetList

'~~>  Array of terms to search for
TargetList = Array("Agenda", "Review", "third", "etc")

'~~> Loop through each slide
For Each sld In pres1.Slides
    '~~> Loop through each shape
    For Each shp In sld.Shapes
        '~~> Check if it has text
        If shp.HasTextFrame Then
            Set txtRng = shp.TextFrame.TextRange

            For i = 0 To UBound(TargetList)
                '~~> Find the text
                Set rngFound = txtRng.Find(TargetList(i))

                '~~~> If found
                Do While Not rngFound Is Nothing
                    '~~> Set the marker so that the next find starts from here
                    n = rngFound.Start + 1
                    '~~> Chnage attributes
                   With rngFound.Font
                        .Bold = msoFalse
                        sld.Copy
                        pres2.Slides.Paste
                        '~~> Find Next instance
                        Set rngFound = txtRng.Find(TargetList(i), n)
                    End With
                Loop
            Next
        End If
    Next
Next
End Sub

The above copies the slides but not the formatting. Additionally, the slides get repeated such that the number of slides in the new presentation number that in the master presentation, when it should be a subset. For example, the master has 60 slides, and the new presentation also has 60 slides instead of 20, say.

How do I copy just the slides that have the specific words as in the target array and keep the formatting of the slides as well?

Have a look at the PowerPoint object model referene, specifically the Slide Object type, and note it's Copy method. msdn.microsoft.com/en-us/vba/powerpoint-vba/articles/… There is also a Select method, but it is probably not necessary to use that, you can just Copy and paste directly. — David Zemens
Thanks David, I used the Copy method and modified the code as per below — shree
I used the .Copy function and it works. But slides pasted are duplicated so that total number of slides in the new presentation number the master and do not have the source formatting. Any ideas how I can copy only the specific slides and keep the source formatting.Thanks — shree
In order to provide an answer to that, it would be necessary for you to revise your question to include your current code implementation. It sounds like you are copying every slide, but really you should only be doing copy/paste once the matching condition is met. That way it will only copy those slides which are needed. — David Zemens

David Zemens David Zemens · Accepted Answer · 2017-08-08T21:17:08

I think first you need to ensure that pres2 is using the same design template/theme as pres1. If pres2 is using a different theme, then the slides will reflect that theme. I don't recall how to do that without spending some time debugging it, but since you're starting from a blank presentation, probably this is easiest:

First, delete all slides from pres2:

Set pres2 = pp.Presentations.Add
Dim i as Long
For i = pres2.Slides.Count to 1 Step - 1
    pres2.Slides(i).Delete
Next

Now you have an empty presentation, and Paste the slides from pres1 should preserve the layout/theme.

sld.Copy
pres2.Slides.Paste

Copy slide based on specific words to new presentation

1 Answers