Consulting

Results 1 to 8 of 8

Thread: Adapt VBA to save selected slides to a default folder with the original file name

  1. #1
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location

    Adapt VBA to save selected slides to a default folder with the original file name

    Hi John

    I have this code, which works great, selected slides are added to a new file ready to save.
    Is there a way for it to save the slides to a specific folder, i.e. C:\MyFolder and name the file with the same filename maybe? This doesn't affect the folder slides are taken from, that just stays open.

    Thank you


    Sub SaveToFolder()
    
    Dim NewPPT As Presentation
    Dim OldPPT As Presentation
    Dim Selected_slds As SlideRange
    Dim Old_sld As Slide
    Dim New_sld As Slide
    Dim Swap As Variant
    Dim x As Long, y As Long
    Dim myArray() As Long
    Dim SortTest As Boolean
      Set OldPPT = ActivePresentation
      Set Selected_slds = ActiveWindow.Selection.SlideRange
        ReDim myArray(1 To Selected_slds.Count)
          For y = LBound(myArray) To UBound(myArray)
            myArray(y) = Selected_slds(y).SlideIndex
          Next y
        Do
          SortTest = False
          For y = LBound(myArray) To UBound(myArray) - 1
            If myArray(y) > myArray(y + 1) Then
              Swap = myArray(y)
              myArray(y) = myArray(y + 1)
              myArray(y + 1) = Swap
              SortTest = True
            End If
          Next y
        Loop Until Not SortTest
        
    'Set variable equal to only selected slides in Active Presentation (in numerical order)
      Set Selected_slds = OldPPT.Slides.Range(myArray)
    
    
    'Create a brand new PowerPoint presentation
      Set NewPPT = Presentations.Add
      
    'Align Page Setup
      NewPPT.PageSetup.SlideHeight = OldPPT.PageSetup.SlideHeight
      NewPPT.PageSetup.SlideOrientation = OldPPT.PageSetup.SlideOrientation
      NewPPT.PageSetup.SlideSize = OldPPT.PageSetup.SlideSize
      NewPPT.PageSetup.SlideWidth = OldPPT.PageSetup.SlideWidth
    
    
    'Loop through slides in SlideRange
      For x = 1 To Selected_slds.Count
        
        'Set variable to a specific slide
          Set Old_sld = Selected_slds(x)
        
        'Copy Old Slide
          y = Old_sld.SlideIndex
          Old_sld.Copy
          
        'Paste Slide in new PowerPoint
          NewPPT.Slides.Paste
          Set New_sld = Application.ActiveWindow.View.Slide
        
        'Bring over slides design
          New_sld.Design = Old_sld.Design
          
        'Bring over slides custom color formatting
          New_sld.ColorScheme = Old_sld.ColorScheme
          
        'Bring over whether or not slide follows Master Slide Layout (True/False)
          New_sld.FollowMasterBackground = Old_sld.FollowMasterBackground
      
      Next x
    End Sub

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    This is off the top of head and totally untested but you should be able to add before End Sub

    call NewPPT.SaveCopyAs ("C:\MyFolder " & OldPPT.Name)
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    Hi John, thanks, but unfortunately it doesn't work, or save. I guessed:

    .Application.ActivePresentation .SaveCopyAs ("C:\MyFolder" & OldPPT.Name)
    .Application.ActivePresentation .SaveAs ("C:\MyFolder" & OldPPT.Name)
    .ActivePresentation PpSaveAsFileType("C:\MyFolder")

    But throws up an error too and doesn't save either.

    Even just opening the SaveAs window over the C:\MyFolder would suffice and the person gives the filename.

    Thanks you in advance.

  4. #4
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Maybe should be
    call NewPPT.SaveCopyAs ("C:\MyFolder\ " & OldPPT.Name)

    I take it C:\MyFolder does actually exist?
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  5. #5
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    Hi John, yes the folder C:\MyFolder exists. I tried the code with the \ but still stayed as if the code wasn't there. It puts the selected slides into a new file, as wanted, named Presentation# (without .pptx and not saved); Save As opens the default folder (i.e. Libraries > Documents). Thank you.

  6. #6
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    It works here.

    Is OldPPT SAVED and is it a pptm?

    You probably need to change SaveCopyAs to a simple SaveAs too.
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  7. #7
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    Hi John, thanks for your quick reply the OldPPT is a saved .pptx

    The main file would be a *.PPTX, and the slides taken out would saved as *.PPTX

    So they may have it open from D:\ or Z:\ drive, say, but after running this VBA and pulling out selected slides, it would then save the new file to C:\MyFolder with the same filename, or that popup where it navigates to C:\MyFolder and the person needs to name that file (a better option I guess).

    Thank you. And thanks for all your past help. This weekend I'm adding these tools to the ribbon then visiting my nephew, but I'll be back Thursday with any reply after 4 pm BST. Thank you.

  8. #8
    VBAX Contributor
    Joined
    Dec 2018
    Location
    South London
    Posts
    115
    Location
    OMG you are a VBA Guru!!!

    THANK YOU!!

    I used:

      Next x
    
      Call NewPPT.SaveAs("C:\MyVault\ " & OldPPT.Name)
      
    Exit Sub
    err:
    MsgBox "Please select slides in an open presentation and then save to your personal vault.  You MUST have a folder C:\MyFolder"
    
    
    End Sub
    Have a wonderful weekend! Will mark this as solved.

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
  •