Solved: call and manipulate save as dialogue in ppt

[werafa]

Hi all,

I have a routine in excel to define a file name, pass this to a save as dialogue, and have the user select a save location.

can anyone say how to do this for a macro enabled ppt, and also to save as a pdf?

my excel specific code is:

myName = InputBox("Please enter a filename", "Filename", myName)
Application.Dialogs(xlDialogSaveAs).Show arg1:=myName, arg2:=xlOpenXMLWorkbookMacroEnabled

Thanks
Tim

[John Wilson]

Try this:

Sub mySaveAS()
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogSaveAs)
With fd
.InitialFileName = Environ("USERPROFILE") & "\Desktop\"
.AllowMultiSelect = False
.FilterIndex = 4
If .Show Then
ActivePresentation.SaveAs FileName:=.SelectedItems(1), _
FileFormat:=ppSaveAsPDF
End If
End With
Set fd = Nothing
End Sub

[werafa]

Thanks John.

Just so I understand: the "userprofile" calls the path to the user account folder, and the "\desktop\" sets the subsequent path? (I would like to use \My Documents\Clients\ as my base folder)

may I set a filename here?

Am I also correct in understanding the If .show tests to see if the file dialogue is open? does this test to see if the dialogue has been cancelled?

[werafa]

Hi John, (and anyone else who needs this)

I had a play, and came up with this:

Sub SaveAndPublish()
' requests file location from user, saves as pptm, then publishes to pdf

Dim fileName As String
Dim myPres As Object
Dim fd As FileDialog

Set myPres = Application.ActivePresentation
Set fd = Application.FileDialog(msoFileDialogSaveAs)

fileName = myPres.FullName
With fd
'get initial file name
If InStr(1, UCase(fileName), "TEMPLATES") > 0 Then
.InitialFileName = Environ("USERPROFILE") & "\My Documents\Clients\"
Else
.InitialFileName = myPres.FullName
End If
.AllowMultiSelect = False
.FilterIndex = 2
If .Show Then
'save as pptm
myPres.SaveAs fileName:=.SelectedItems(1), FileFormat:=ppSaveAsOpenXMLPresentationMacroEnabled
End If
End With
fileName = myPres.FullName
If InStr(1, fileName, "pptm", 0) > 0 Then
fileName = Replace(fileName, "pptm", "PDF")
ElseIf UCase(Right(fileName, 3)) = "PDF" Then
'do nothing
Else
fileName = fileName & ".pdf"
End If
'save as pdf
myPres.SaveAs fileName, ppSaveAsPDF

Set myPres = Nothing
Set fd = Nothing
End Sub

It responds to a hardwired folder structure, saves the pptm file to a selected folder - or re-saves in prev. selected folder, then publishes to pdf without the normal 'overwrite file' prompt.

Thanks for the head start John, and happy reverse engineering to everyone else :work: