Consulting

Results 1 to 11 of 11

Thread: Delete everything but the title

  1. #1

    Delete everything but the title

    I have a VBA to copy my selected range in excel and paste it into my current PPT slide. I am trying to add a process to the code that deletes everything in the active slide except for the title prior to pasting. Here is what I have but it is very inconsistent.

    Sometimes it deletes the title, sometimes it deletes the previously pasted range, sometimes it works perfectly. Very confused why it is so inconsistent.

    Any input would be greatly appreciated!

    Dim mySlide As Object
    Set mySlide = PowerPointApp.ActiveWindow.View.Slide
    
      For Each Shape In mySlide.Shapes      If Shape.Type <> msoPlaceholder Then Shape.Delete
      Next

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Delete bottoms-up

    For i = mySlide.Shapes.count to 1 Step -1
        If mySlide.Shapes(i).Type = msoPlaceHolder Then  
    mySlide.Shapes(i).Delete Next i
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Thanks for the quick response Paul! I like your approach on that. Unfortunately I am getting "compile error: next without for"

  4. #4
    When I take the if statement out it works but it deletes the title as well

  5. #5
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    What do you mean by "Title"? If you mean Text in a Title Placeholder?

    Sub zapTitle()
    
    
    Dim osld As Slide
    Set osld = ActiveWindow.Selection.SlideRange(1)
    Dim L As Long
    For L = osld.Shapes.Count To 1 Step -1
    If osld.Shapes(L).Id <> osld.Shapes.Title.Id Then
    osld.Shapes(L).Delete
    End If
    Next L
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  6. #6
    Your Advice worked perfect! Thank you John! If interested in the overall goal -

    I have about 60 Tables in Excel that I put into different powerpoints each month. All of the slides I am working with have a title, a table, and some (not all) have bullet points in text boxes. I am writing a code that allows me to highlight a table in excel, press the macro shortcut key and produce the following actions

    - Delete all of the content in the selected slide excluding the title box and words in the title box
    - Paste the selected table from excel into the selected slide

    For reference, here is my full code. Please let me know if you have any recommendations to make it more concise!

    Sub ExcelRangeToPowerPoint()
    
    Dim rng As Range
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Slide
    Dim myShape As Object
    
    
    'Copy Range from Excel
      Set rng = Selection
      rng.Copy
    
    
    'Create an Instance of PowerPoint
      On Error Resume Next
        
        'Is PowerPoint already opened?
          Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        
        'Clear the error between errors
          Err.Clear
    
    
        'If PowerPoint is not already open then open PowerPoint
          If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
        
        'Handle if the PowerPoint Application is not found
          If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
          End If
    
    
      On Error GoTo 0
    
    
      Application.ScreenUpdating = False
      
      Set myPresentation = PowerPointApp.ActivePresentation
      
      Set mySlide = PowerPointApp.ActiveWindow.Selection.SlideRange(1)
      
      Dim L As Long
      For L = mySlide.Shapes.Count To 1 Step -1
      If mySlide.Shapes(L).ID <> mySlide.Shapes.Title.ID Then
      mySlide.Shapes(L).Delete
      End If
      Next L
    
    
    'Paste to PowerPoint and position
      mySlide.Shapes.Paste
      Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
      
        'Set position:
          myShape.Left = 66
          myShape.Top = 152
    
    
    'Make PowerPoint Visible and Active
      PowerPointApp.Visible = True
      PowerPointApp.Activate
    
    
    'Clear The Clipboard
      Application.CutCopyMode = False
      
    End Sub
    Last edited by cwojtak; 07-23-2019 at 12:58 PM.

  7. #7
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,711
    Location
    Quote Originally Posted by cwojtak View Post
    Thanks for the quick response Paul! I like your approach on that. Unfortunately I am getting "compile error: next without for"
    Forum software sometimes breaks lines where it's not intended


    For i = mySlide.Shapes.count to 1 Step -1
        If mySlide.Shapes(i).Type = msoPlaceHolder Then   mySlide.Shapes(i).Delete
    Next i
    Edit -- go with John's since you have a lot more going on that just deleting some shapes on a slide and it will be easier to expand to meet your need
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  8. #8
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Paul's advice to loop in reverse if you are deleting anything is good (vital even)!
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  9. #9
    Adding to my question, please let me know if I need to start a new thread but I feel this relates. I am now trying to get the code to move to the next slide now. The code below works but I am struggling to incorporate it at the end of the complete sub (Shown in reply #6). Any input?

    Dim rng As RangeDim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Slide
    Dim myShape As Object
    
    
    'Copy Range from Excel
      Set rng = Selection
      rng.Copy
    
    
    'Create an Instance of PowerPoint
      On Error Resume Next
        
        'Is PowerPoint already opened?
          Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        
        'Clear the error between errors
          Err.Clear
    
    
        'If PowerPoint is not already open then open PowerPoint
          If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
        
        'Handle if the PowerPoint Application is not found
          If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
          End If
    
    
      On Error GoTo 0
    
    
      Application.ScreenUpdating = False
      
      Set myPresentation = PowerPointApp.ActivePresentation
      Set mySlide = PowerPointApp.ActiveWindow.Selection.SlideRange(1)
    
      
      a = mySlide.SlideIndex
      a = a + 1
      myPresentation.Slides(a).SelectEnd Sub

  10. #10
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Maybe (not quite sure what you mean)

    Sub ExcelRangeToPowerPoint()
    
    Dim rng As Range
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim mySlide As Object
    Dim myShape As Object
    
    
    
    
    'Copy Range from Excel
      Set rng = Selection
      rng.Copy
    'Create an Instance of PowerPoint
      On Error Resume Next
    
    
        'Is PowerPoint already opened?
          Set PowerPointApp = GetObject(class:="PowerPoint.Application")
        
        'Clear the error between errors
          Err.Clear
    
    
        'If PowerPoint is not already open then open PowerPoint
          If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(class:="PowerPoint.Application")
        
        'Handle if the PowerPoint Application is not found
          If Err.Number = 429 Then
            MsgBox "PowerPoint could not be found, aborting."
            Exit Sub
          End If
      On Error GoTo 0
      Application.ScreenUpdating = False
      
      Set myPresentation = PowerPointApp.ActivePresentation
      
      Set mySlide = PowerPointApp.ActiveWindow.Selection.SlideRange(1)
      
      Dim L As Long
      If mySlide.Shapes.HasTitle Then
        For L = mySlide.Shapes.Count To 1 Step -1
      If mySlide.Shapes(L).ID <> mySlide.Shapes.Title.ID Then
      mySlide.Shapes(L).Delete
      End If
        Next L
      Else
      mySlide.Shapes.Range.Delete
      End If
    'Paste to PowerPoint and position
      mySlide.Shapes.Paste
      Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
      
        'Set position:
          myShape.Left = 66
          myShape.Top = 152
    ' Next slide
    If mySlide.slideindex < myPresentation.slides.Count Then
    myPresentation.slides(mySlide.slideindex + 1).Select
    End If
    'Make PowerPoint Visible and Active
      PowerPointApp.Visible = True
      PowerPointApp.Activate
    
    
    'Clear The Clipboard
      Application.CutCopyMode = False
     
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  11. #11
    Exactly what I was looking for, thank you John!

Posting Permissions

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