Consulting

Results 1 to 2 of 2

Thread: make new pptx files based on the value of a textbox

  1. #1

    make new pptx files based on the value of a textbox

    Hello,

    I am hopeful someone out there can lend me a quick hand.

    I have a some pptx file that all have a subanner textbox value. all the slide format is all the same. I am using excel to open the files.

    I'm working to spilt the larger presentation into smaller presentations based on the value of the subanner textbox.

    also i need to keep the original slide formatting in the spilt presentations.

    sometimes it runs fine, other times I get an error that says " Something went wrong that might make PowerPoint Unstable"
    any words of wisdom would be greatly appreciated

    Sub CopySlides()
    Dim pptApp As PowerPoint.Application
    Dim pptPres As PowerPoint.Presentation
    Dim newPres As PowerPoint.Presentation
    Dim slide As PowerPoint.slide
    Dim subbanner As PowerPoint.shape
    Dim lastSubbannerText As String
    Dim filePath As String
    'Open the PowerPoint presentation
    Set pptApp = CreateObject("PowerPoint.Application")
    filePath = Range("a12").Value
    Set pptPres = pptApp.Presentations.Open(filePath)
    'Create a new presentation
    Set newPres = pptApp.Presentations.Add
    'Loop through each slide in the presentation
    For Each slide In pptPres.Slides
    'Find the subbanner shape on the slide
    Set subbanner = slide.Shapes.Range(Array("subbanner")).Item(1)
    'If the subbanner text on the current slide is different from the last slide, save and close the current presentation and create a new one
    If subbanner.TextFrame.TextRange.Text <> lastSubbannerText Then
    'Save and close the current presentation
       'newPres.Close
       'Create a new presentation
       Set newPres = pptApp.Presentations.Add
    End If
    'Copy the slide to the clipboard
    slide.Copy
    'Paste the slide into the new presentation with the source formatting
    pptApp.CommandBars.ExecuteMso ("PasteSourceFormatting")
    'Save the text of the current subbanner for comparison with the next slide
    lastSubbannerText = subbanner.TextFrame.TextRange.Text
    Next
    'Save and close the final presentation
    'newPres.Close
    End Sub
    Last edited by Aussiebear; 01-05-2023 at 12:24 PM. Reason: Removed the whitespace within the code

  2. #2
    VBAX Mentor
    Joined
    Nov 2022
    Location
    The Great Land
    Posts
    326
    Location
    Without knowing conditions that triggered error, hard to advise. You could provide your file for analysis.
    How to attach file: Reading and Posting Messages (vbaexpress.com), click Go Advanced below post edit window. To provide db: copy, remove confidential data, run compact & repair, zip w/Windows Compression.

Tags for this Thread

Posting Permissions

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