Consulting

Results 1 to 6 of 6

Thread: VBA Save file to user desktop, close existing file and open saved file?

  1. #1

    VBA Save file to user desktop, close existing file and open saved file?

    Hi,

    I would like to create VBA that will make a copy oy the currently opened .pptm file to the users desktop, close the current file that the macro is in, and open the newly save filed from the desktop.

    Any help?

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    Try this.

    If you need the macro preserved use pptm instead of pptx

    Sub do_that()
    Dim opres As Presentation
    Set opres = ActivePresentation
    ActivePresentation.SaveCopyAs Environ("USERPROFILE") & "\Desktop\copy.pptx"
    Presentations.Open Environ("USERPROFILE") & "\Desktop\copy.pptx"
    opres.Close
    End Sub
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    John, for me, PP would never find the path Environ("USERPROFILE") & "\Desktop\.
    gmooney, the SaveCopyAs method saves a copy of the file to the location you specified, but the original file remains active. The SaveAs method saves the file with a new name at the specified location, the original file is closed, and the new file becomes active. But be careful! When saving with the SaveAs method, the original file is dropped without saving the changes. If you make changes from the moment of opening the file, until saving under a new name, and you want to save them in a copy, you need to save the file using the Save method and then use SaveAs.Below is a macro using the SaveAs method and a safer way to locate the Desktop.
    Sub do_that_1()
    
    
        With ActivePresentation
            '.Save '- if needed
            .SaveCopyAs GetDesktopPath & "copy.pptx"
        End With
    End Sub
    
    
    
    
    Function GetDesktopPath()
        Dim WSHShell    As Object
    
    
        Set WSHShell = CreateObject("Wscript.Shell")
        GetDesktopPath = WSHShell.SpecialFolders(4)
        If Right(GetDesktopPath, 1) <> "\" Then
            GetDesktopPath = GetDesktopPath & "\"
        End If
    End Function
    Artik

  4. #4
    Artik,

    The user will be adding 25 slides from another PPT file via the Reuse slides options. Then they are supposed to run the following code below that I currently have. It essentially rearranges the slides an deletes on slide. My save code can be modified to use what you think is the best from your code. I do not believe that I need to existing PPT macro file to ever be saved.

    Sub RearrangeSlidesToNewLocation()


    Dim strName As String


    ActivePresentation.Slides(2).MoveTo toPos:=34
    ActivePresentation.Slides(2).MoveTo toPos:=34
    ActivePresentation.Slides(2).MoveTo toPos:=36
    ActivePresentation.Slides(2).MoveTo toPos:=36
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=38
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=40
    ActivePresentation.Slides(2).MoveTo toPos:=42
    ActivePresentation.Slides(2).MoveTo toPos:=42
    ActivePresentation.Slides(2).MoveTo toPos:=42
    ActivePresentation.Slides(2).MoveTo toPos:=42
    ActivePresentation.Slides(2).MoveTo toPos:=42






    strName = ActivePresentation.Slides(2).Shapes("Title 1").TextFrame.TextRange.Text
    ActivePresentation.Slides(2).Delete
    ActivePresentation.Slides(1).Select


    With Application.ActivePresentation
    .SaveCopyAs strName
    End With






    MsgBox "Your new Category Review has been saved. Please close this file and open the newly saved file. You can then begin your Category Review work."


    End Sub

  5. #5
    VBAX Mentor
    Joined
    Dec 2008
    Posts
    404
    Location
    Gmooney, please use [CODE] tags when quoting your code (use # button).
    I made an obvious mistake in the previous post. I was talking about SaveAs, but I wrote SaveCopyAs in the code. I'm sorry.

    You can also write your code this way:
    Sub RearrangeSlidesToNewLocation()
        Dim i           As Long
        Dim varrPos     As Variant
    
    
        varrPos = Array(34, 34, _
                        36, 36, _
                        38, 38, 38, 38, 38, 38, 38, _
                        40, 40, 40, 40, 40, 40, 40, 40, 40, _
                        42, 42, 42, 42, 42)
    
    
        With ActivePresentation
            For i = 0 To UBound(varrPos)
                .Slides(2).MoveTo toPos:=varrPos(i)
            Next i
    
    
            strName = .Slides(2).Shapes("Title 1").TextFrame.TextRange.Text
            .Slides(2).Delete
            .Slides(1).Select
    
    
            .SaveAs GetDesktopPath & strName & ".pptx"
        End With
    
    
        MsgBox "Your new Category Review has been saved." & vbLf & _
               "You can start work.", vbInformation
    End Sub
    plus GetDesktopPath function.

    Artik

  6. #6
    Artik,

    This doesn't seem to do the saving of the file and I do not get the message box at the end. It does all the rearranging of the slides and deletes the slide 1 and selects slide 1.

    One thing I failed to mention; the user will need to put the PPT into slide show mode in order to click on an action button to fire the macro. Maybe this is causing problems?

    Where does the function code go and how does it get called? Does it go in Module 1 with this Macro?

    Also, can you tell me what versions of PPT this code will work on?
    Last edited by gmooney100; 06-01-2021 at 08:31 AM.

Posting Permissions

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