Event Handling and SaveAs

  • Thread starter Thread starter Sascha Rasmussen
  • Start date Start date
S

Sascha Rasmussen

Hello,

I'm trying to write my own FileSave-Dialog for several MS-Office-
Applications and succeeded in Word and Excel so far, now Powerpoint is
giving me headaches.

Here is my code

Module Globals
Public blnEventHandling As Boolean

Dim AppClass As New EventClass

Private Sub Auto_Open()
Set AppClass.PPTEvent = Application
blnEventHandling = True
End Sub

ClassModule EventClass
Public WithEvents PPTEvent As Application

Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As
Presentation, _
Cancel As Boolean)
Cancel = True
If Globals.blnEventHandling = True Then
Globals.blnEventHandling = False
Pres.SaveAs FileName:="C:\temp\foobar.ppt"
Globals.blnEventHandling = True
End If
End Sub

Pres.SaveAs always throws a Runtime Error '-2147467259 (80004005)'
Presentation (unknown member): Failed

After that the presentation isn't saved, but the window caption reads
"foobar.ppt".

Can anyone provide me some help?

Thanks in advance,

Sascha Rasmussen
 
Isn't there anybody out there, that can provide me some help?

Bye,

Sascha Rasmussen
 
I have seen this problem earlier. One of the possible workaround you can try
is to save the presentation later and not in the BeforeSave handler. You
might want to rewrite the code using the following pseudocode:

Dim IAmSaving As Boolean

Sub BeforeSaveEventHandler()
if not IAmSaving then
Cancel = True
IAmSaving = True
StartTimer
endif
End Sub

Sub TimerHandler()
StopTimer
Pres.SaveAs ...
IAmSaving = False
End Sub

- Chirag

PowerShow - View multiple PowerPoint slide shows simultaneously
http://officeone.mvps.org/powershow/powershow.html
 
Dear Chirag,

thank you for your advice, I will see if I am able to catch a Timer
Event.

Bye,

Sascha Rasmussen
 
It gets very annoying, now my code is somehow looking like this:

Module Globals
Public Const APP_TIMER_EVENT_ID As Long = 999
Public blnEventHandling As Boolean
Public bTimerState As Boolean

Dim AppClass As New EventClass

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Private Sub Auto_Open()
Set AppClass.PPTEvent = Application
blnEventHandling = True
End Sub

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim tmr As Long
If Globals.bTimerState = False Then
Globals.bTimerState = True
tmr = Globals.KillTimer(0, Globals.APP_TIMER_EVENT_ID)
Globals.blnEventHandling = False
ActivePresentation.SaveAs FileName:="C:\temp\foobar.ppt"
Globals.blnEventHandling = True
End If
End Sub


ClassModule EventClass
Public WithEvents PPTEvent As Application

Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As
Presentation, _
Cancel As Boolean)
Cancel = True
If Globals.blnEventHandling = True Then
Globals.bTimerState = False
tmr = Globals.SetTimer(0, Globals.APP_TIMER_EVENT_ID, 2000,
AddressOf Globals.TimerProc)
End If
End Sub

I still get the above mentioned error, it only takes 2000 milliseconds
more, plus when I hit stop in the error message or debugger Powerpoint
crashes. :-(

Bye,

Sascha Rasmussen
 
I haven't tried yout code but I think "Cancel = True" should be within the
If block in BeforeSave() handler.

Also, when hWnd is 0 in SetTimer(), the nIDEvent is ignored. The return
value of SetTimer() needs to be passed to KillTimer() as nIDEvent. You can
get rid of APP_TIMER_EVENT_ID from your code and use 0 for nIDEvent in
SetTimer().

- Chirag

PowerShow - View multiple PowerPoint slide shows simultaneously
http://officeone.mvps.org/powershow/powershow.html
 
The moving of Cancel=True did the trick, thanks.

BTW as Shyam Pillai mentioned on http://skp.mvps.org/ppt00021.htm one
can set hWnd and nIDEvent both to 0

Module Globals
Public blnEventHandling As Boolean
Public bTimerState As Boolean

Dim AppClass As New EventClass

Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long

Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long

Private Sub Auto_Open()
Set AppClass.PPTEvent = Application
blnEventHandling = True
End Sub

Sub TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
Dim tmr As Long
If Globals.bTimerState = False Then
Globals.bTimerState = True
tmr = Globals.KillTimer(0, 0)
Globals.blnEventHandling = False
ActivePresentation.SaveAs FileName:="C:\temp\foobar.ppt"
Globals.blnEventHandling = True
End If
End Sub

ClassModule EventClass
Public WithEvents PPTEvent As Application

Private Sub PPTEvent_PresentationBeforeSave(ByVal Pres As
Presentation, _
Cancel As Boolean)
If Globals.blnEventHandling = True Then
Cancel = True
Globals.bTimerState = False
tmr = Globals.SetTimer(0, 0, 250, AddressOf Globals.TimerProc)
End If
End Sub

I set dwTime to 250 milliseconds, this is fast enough to do not bother
the user and slow enough not to raise the unknown member error.

Bye,

Sascha Rasmussen
 
Back
Top