VBA PowerPoint 2007 runtime error: ActivePresentation.SaveAs filename

Question

Hey there,

I wrote some text in PowerPoint 2007 VBA that set the filename automatically depending on a user's choice in UserForm1. The UserForm shows up once the user clicks the PowerPoint save button. In UserForm1 there is a ListBox with texts like "A, B, C" and so on.

The user clicks a letter and when clicks a button in UserForm1 this code should be executed:

'name1 is for example "Presentation-B"

Application.FileDialog(Type:=msoFileDialogSaveAs).InitialFileName = name1

If Application.FileDialog(Type:=msoFileDialogSaveAs).Show = -1 Then

  name1 = Application.FileDialog(msoFileDialogSaveAs).SelectedItems(1)

'name1 is now the path, filename with a letter and extenstion, e.g. "C:\Presentation-B.pptx"

'the cause of runtime error:

  ActivePresentation.SaveAs name1

End If

The error message i got:

Runtime error '-2147467259 (80004005)':

Presentation (unkown member) : Failed.

Can someone help me with this problem?

Thanks in advance.

My system:

Microsoft Windows 7 Enterprise SP1 x86/32-bit

Microsoft Office Standard 2007 SP3

Code in class module:

Option Explicit

Public WithEvents PPTEvent As Application

Dim wannasave As Boolean

Dim asked As Boolean

Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As Presentation, Cancel As Boolean)

  wannasave = True

  If asked = False Then

    Cancel = True

    Call PPTEvent_PresentationSave(ByVal Pres)

  Else

    Cancel = False

  End If

End Sub

Private Sub PPTEvent_PresentationSave(ByVal Pres As Presentation)

  If wannasave = False And asked = True Then Exit Sub

  asked = True

  Dim Cancel As Boolean

  Dim tmp As String

  Dim tmpint As Integer

  Dim dp As Object

  Dim answer

  Set dp = ActivePresentation.BuiltInDocumentProperties

  tmp = dp("KeyWords")

  tmpint = InStr(tmp, " indexed")

  If InStr(tmp, " indexed") Then

    answer = MsgBox("Change index?", vbYesNo + vbQuestion, "Change index?")

    If answer = vbYes Then

      On Error Resume Next

      Cancel = True

   'if user clicks button in UserForm1 the document should save with code at the top

      UserForm1.Show (vbModal)

      Cancel = True

    Else

      abort = False

      Unload UserForm1

    End If

  Else

    answer = MsgBox("Indexing document?", vbYesNoCancel + vbQuestion, "Indexing?")

    If answer = vbYes Then

      On Error Resume Next

      Cancel = True

      UserForm1.Show (vbModal)

   'if user clicks button in UserForm1 the document should save with code at the top

      Cancel = True

    ElseIf answer = vbCancel Then

      Cancel = True

    Else

      abort = False

    End If

  End If

  If abort = True Then

    Cancel = True

  End If

End Sub

Answer 1

Nobody could help me?

Answer 2

I haven't tested it in PowerPoint 2010 and it has to work with PowerPoint 2007 because we're using PP 2007 only.

I exported and zipped all files (UserForm1, module 1, module 2 and class module). You can download the .zip file here (mediafire.com).

Please note: there are some German words/phrases in the code but what's written in German isn't relevant to understand what the add-in should do.

Answer 3

I just copy/pasted your code into PowerPoint (2010 in this case), added Sub/End sub lines and Dim name1 as string.  Ran it, It worked.

You might want to paste in a complete code sample.

Answer 4

My fault, I should use copy & paste next time...

I tried your suggestion with "Option Explicit" on top of the class module but it hasn't fixed my problem. Same runtime error as before at same position.

I edited my first post and added more of my code. Hope this will help a little more.

Answer 5

It should be

ActivePresentation.SaveAs name1  ' name1 rather than name

That'll solve the immediate problem.

But a suggestion: Always (Always Always ALWAYS) start every module with

Option Explicit

In fact, choose Tools | Options | Editor tab

Put a check next to "Require Variable Declaration"

Now VBA will include Option Explicit for you automatically at the top of each new module.

This would have caught the error and told you want it was the first time you tried to run the code.