VBA Code - Copying and Pasting selected slides (based on selected keywords/criteria in each slide)
Results 1 to 10 of 10

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

  1. #1
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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

  2. #2
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    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 by Yongle; Aug 18th, 2019 at 04:42 AM.

  3. #3
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    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 by Yongle; Aug 18th, 2019 at 06:02 AM.

  4. #4
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    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 by Yongle; Aug 18th, 2019 at 07:04 AM.

  5. #5
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    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

  6. #6
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    Start at post 2 and we'll take it from there

  7. #7
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    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 = "C:\Folder\SubFolder\DeckA.pptx"
        Const DeckB = "C:\Folder\SubFolder\DeckB.pptx"
        Dim ListOfSlides As String, myPhrase
        Dim sldNo As Variant, deck As Variant
        Dim A As Presentation, P As Presentation
        Set A = ActivePresentation
    'looking for what?
        myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")
    'insert slides
        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 by Yongle; Aug 19th, 2019 at 03:05 AM.

  8. #8
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Quote Originally Posted by Yongle View Post
    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 = "C:\Folder\SubFolder\DeckA.pptx"
        Const DeckB = "C:\Folder\SubFolder\DeckB.pptx"
        Dim ListOfSlides As String, myPhrase
        Dim sldNo As Variant, deck As Variant
        Dim A As Presentation, P As Presentation
        Set A = ActivePresentation
    'looking for what?
        myPhrase = InputBox("enter a phrase", "Search for what?", "the cat")
    'insert slides
        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?

  9. #9
    New Member
    Join Date
    Aug 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

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

    Quote Originally Posted by erickhaw View Post
    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.

  10. #10
    Board Regular
    Join Date
    Mar 2015
    Posts
    3,748
    Post Thanks / Like
    Mentioned
    66 Post(s)
    Tagged
    7 Thread(s)

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

    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/off...e.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 by Yongle; Aug 19th, 2019 at 02:53 PM.

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •