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?
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?
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
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.ArtikSub 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,
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
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:plus GetDesktopPath function.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
Artik
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.