VBA Code - Copying and Pasting selected slides (based on selected keywords/criteria in each slide)

erickhaw

New Member
Joined
Aug 16, 2019
Messages
4
Hi all,

Is there any way to automate the copying and pasting of selected powerpoint slides via macro/vba? I have a master deck of 100 slides, however only selected slides are required to be paste into a new clean deck. Is there any way to copy the slides based on an array search on specific key words (e.g. Title, Content). And based on the selected phrase/title the specific slides will be extracted out and paste into a new deck. The search should based on keywords and not on slide numbers as the slides grows over time..

I will require the input from two different source to create a new deck.

e.g. DeckA (100 slides) / DeckB (20 Slides)

DeckC (New slides created based on extraction of selected slides from Deck A followed by Deck B). The new deck (output) created should be in proper slides sequence.

Thank you!
Regards
Eric
 

Excel Facts

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
Welcome to the forum

Yes what you want can be done - but you need to build this step by step

1. Add this code to one of your presentations to familiarise yourself with the names of the various objects (you need those help you filter what is being searched)
Code:
Sub GetShapeNames()
    Dim sld As Slide, shp As Shape, list As String, msg As String
    For Each sld In Application.ActivePresentation.Slides
        For Each shp In sld.Shapes
                msg = sld.Name & vbTab & shp.Name
                If list = "" Then list = msg Else list = list & vbCr & msg
        Next shp
    Next sld
    MsgBox list
End Sub

2. Add this code to familiarise yourself with how to search for what you want in the shapes that are relevant
- the message box lists the names of the matching slides separated by commas
- modify it to suit your search criteria
- as currently written it searches IN any shape (in every slide) where shape name begins with "Title" FOR the word or phrase entered in the input box

Code:
Sub FindText()
Dim sld As Slide, shp As Shape, list As String, myPhrase As String
myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")
[CODE]For Each sld In Application.ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            If Left(shp.Name, 5) = "Title" Then
                If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
                    If list = "" Then list = sld.Name Else list = list & "," & sld.Name
                End If
            End If
        End If
    Next shp
Next sld
MsgBox list
End Sub
 
Last edited:
Upvote 0
That last bit of code got posted a bit wrong!!

Code:
Sub FindText()
Dim sld As Slide, shp As Shape, list As String, myPhrase As String
myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")

For Each sld In Application.ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.HasTextFrame Then
            If Left(shp.Name, 5) = "Title" Then
                If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
                    If list = "" Then list = sld.Name Else list = list & "," & sld.Name
                End If
            End If
        End If
    Next shp
Next sld
MsgBox list
End Sub
 
Last edited:
Upvote 0
After you have played around with FindText, then the procedure should be tailored to give you the search flexibility that you need without ameding the code each time

How that is achieved depends on
- which types of objects are included in your presentation (simple shapes, tables ... etc)
- and which options you want when searching (eg search Headers only , search all text, exclude headers from search, search tables, exclude tables etc)
 
Last edited:
Upvote 0
Hi Yongle,

I added the following below and noted some errors. Sorry new to vba, could you assist below together with the file import from two deck.. Thank you!

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

Sub GetShapeNames()
Dim sld As Slide, shp As Shape, list As String, msg As String
For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
msg = sld.Name & vbTab & shp.Name
If list = "" Then list = msg Else list = list & vbCr & msg
Next shp
Next sld
MsgBox list
End Sub

Sub FindText()
Dim sld As Slide, shp As Shape, list As String, myPhrase As String
myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")

For Each sld In Application.ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If Left(shp.Name, 5) = "Title" Then
If Not shp.TextFrame.TextRange.Find(FindWhat:=myPhrase) Is Nothing Then
If list = "" Then list = sld.Name Else list = list & "," & sld.Name
End If
End If
End If
Next shp
Next sld
MsgBox list
End Sub
 
Upvote 0
Start at post 2 and we'll take it from there
 
Upvote 0
This code has been tested

1. Open a NEW powerpoint presentation
2. Insert a module in that presentation and paste the code below into that module
3. Amend paths to the 2 files
4. Run the code

(As before) the search is limited to any objects with names containg Title as first 5 characters

Code:
Sub CopySlides()
    Const DeckA = "[COLOR=#ff0000]C:\Folder\SubFolder\DeckA.pptx[/COLOR]"
    Const DeckB = "[COLOR=#ff0000]C:\Folder\SubFolder\DeckB.pptx[/COLOR]"
    Dim ListOfSlides As String, myPhrase
    Dim sldNo As Variant, deck As Variant
    Dim A As Presentation, P As Presentation
    Set A = ActivePresentation
[I][COLOR=#006400]'looking for what?[/COLOR][/I]
    myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")
[I][COLOR=#006400]'insert slides[/COLOR][/I]
    For Each deck In Array(DeckA, DeckB)
        Set P = Presentations.Open(deck)
        ListOfSlides = GetSlides(myPhrase, P)
        If Not ListOfSlides = "" Then
            For Each sldNo In Split(ListOfSlides, ",")
                A.Slides.InsertFromFile deck, A.Slides.Count, sldNo, sldNo
            Next sldNo
        End If
        P.Close
    Next deck
End Sub

Function GetSlides(aPhrase, aPres) As String
    Dim sld As Slide, shp As Shape, list As String
    For Each sld In aPres.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If Left(shp.Name, 5) = "Title" Then
                    If Not shp.TextFrame.TextRange.Find(FindWhat:=aPhrase) Is Nothing Then
                        If list = "" Then list = sld.SlideIndex Else list = list & "," & sld.SlideIndex
                    End If
                End If
            End If
        Next shp
    Next sld
    GetSlides = list
End Function

What the code does
- user provides search phrase or word
- each deck is opened in sequence
- the function returns a string containing the matching slide NUMBERS (delimited by a comma)
- that string is split and the appropriate slide inserted in the same sequence in the NEW presentation
- the deck is closed

If you would prefer to do this from Excel, that can be done, but initially it is less complicated to work in powerpoint
Amending the code to work from Excel can be done when everything is fully tested and working in powerpoint

Do you need any help amending the function to search in the manner you want?
 
Last edited:
Upvote 0
This code has been tested

1. Open a NEW powerpoint presentation
2. Insert a module in that presentation and paste the code below into that module
3. Amend paths to the 2 files
4. Run the code

(As before) the search is limited to any objects with names containg Title as first 5 characters

Code:
Sub CopySlides()
    Const DeckA = "[COLOR=#ff0000]C:\Folder\SubFolder\DeckA.pptx[/COLOR]"
    Const DeckB = "[COLOR=#ff0000]C:\Folder\SubFolder\DeckB.pptx[/COLOR]"
    Dim ListOfSlides As String, myPhrase
    Dim sldNo As Variant, deck As Variant
    Dim A As Presentation, P As Presentation
    Set A = ActivePresentation
[I][COLOR=#006400]'looking for what?[/COLOR][/I]
    myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")
[I][COLOR=#006400]'insert slides[/COLOR][/I]
    For Each deck In Array(DeckA, DeckB)
        Set P = Presentations.Open(deck)
        ListOfSlides = GetSlides(myPhrase, P)
        If Not ListOfSlides = "" Then
            For Each sldNo In Split(ListOfSlides, ",")
                A.Slides.InsertFromFile deck, A.Slides.Count, sldNo, sldNo
            Next sldNo
        End If
        P.Close
    Next deck
End Sub

Function GetSlides(aPhrase, aPres) As String
    Dim sld As Slide, shp As Shape, list As String
    For Each sld In aPres.Slides
        For Each shp In sld.Shapes
            If shp.HasTextFrame Then
                If Left(shp.Name, 5) = "Title" Then
                    If Not shp.TextFrame.TextRange.Find(FindWhat:=aPhrase) Is Nothing Then
                        If list = "" Then list = sld.SlideIndex Else list = list & "," & sld.SlideIndex
                    End If
                End If
            End If
        Next shp
    Next sld
    GetSlides = list
End Function

What the code does
- user provides search phrase or word
- each deck is opened in sequence
- the function returns a string containing the matching slide NUMBERS (delimited by a comma)
- that string is split and the appropriate slide inserted in the same sequence in the NEW presentation
- the deck is closed

If you would prefer to do this from Excel, that can be done, but initially it is less complicated to work in powerpoint
Amending the code to work from Excel can be done when everything is fully tested and working in powerpoint

Do you need any help amending the function to search in the manner you want?


Thanks for assisting yongle:
1. Is there any limitation to myphrase key words? As i may need to search the key words across "title" , "paragraph", "bullet points", "shapes", "charts" etc. Would such scenarios be applicable to the deck?
 
Upvote 0
Thanks for assisting yongle:
1. Is there any limitation to myphrase key words? As i may need to search the key words across "title" , "paragraph", "bullet points", "shapes", "charts" etc. Would such scenarios be applicable to the deck?
Concurrently at the same time.
 
Upvote 0
Is there any limitation to myphrase key words? As i may need to search the key words across "title" , "paragraph", "bullet points", "shapes", "charts" etc. Would such scenarios be applicable to the deck? Concurrently at the same time.

Searching capability

- the code currently searches for a complete phrase (which may be a single word) but only in a Title box
- a list of words (or phrases) could be searched for by adding a simple loop
- other flexibility can be also be added to the search by modifying the search code

VBA needs to be told which objects to search (or not search)
- in post#2, GetShapeNames was provided to help you ascertain the names of various objects in your presentations
- GetShapeNames could be easily modified to dump the various values to a worksheet rather than a message box
- searching all objects is easy, but if you want options to "pick and choose", then the code needs modifying so that those variables can be fed in manually at the time of the search

I suggest you spend some time ..
- establishing which objects are in your presentation
- deciding what should be included or excluded in your searches
- how you want to search etc
- try running run GetShapeNames (it will probably throw up a few questions)

Here is another macro that may provide some useful information
- it provides the shape type (code) which can be looked up in the link below (the shape name should often be enough)
- values are dumped to the immediate window which can be viewed (when in VBA) with {CTRL} G
Code:
Sub ShapeTypes()
    Dim Shp As Shape, Sld As Slide
    For Each Sld In ActivePresentation.Slides
        For Each Shp In Sld.Shapes
           Debug.Print Sld.Name, Shp.Type, Shp.Name
        Next
    Next Sld
End Sub

You may be able to filter simply on names or may need to make use of object type code number - here is a list of those codes
https://docs.microsoft.com/en-us/office/vba/api/office.msoshapetype

When you are familiar with the objects in your presentation and what you want, come back with that information (including specifics based on either object names or object types)
- we can then work together to modify the code to try to achieve what you want
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

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