View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Tony Starr[_3_] Tony Starr[_3_] is offline
external usenet poster
 
Posts: 4
Default Workbook won't save

Hi All,

I have a worksheet with Customized BeforeSave and BeforeClose events.

The Customized BeforeSave event allows me to let the user save the workbook
and then output one of the sheets in xml format to a file with the same name
as the workbook but with a .xml extension.

The Customized BeforeClose event allows me to restore the toolbars to the
state they were in when the spreadsheet opened.

The problem is as follows.
IF I open the spreadsheet, change the data and then close the spreadsheet,
the message box appears saying "Do you want to save changes .....". I answer
yes.
Stepping through the code I find that the Me.Save statement in the
BeforeClose event triggers the BeforeSave event. So far so good.

Stepping through the BeforeSave event I get to the ThisWorkbook.Save
statement. The debugger shows this statement being executed but the workbook
does not save.
Executing ThisWorkbook.Save in the Immediate window has no effect either.
Allowing the code to continue running causes the workbook to close without
any changes being saved.

To reproduce this problem add the following code to the ThisWorbook module
of a blank spreadsheet. Save the workbook and close it. Open the workbook,
change some data somewhere and select close.


Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not Me.Saved Then
Msg = "Do you want to save the changes you made to "
Msg = Msg & Me.Name & "?"
Ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
Select Case Ans
Case vbYes
Me.Save
Me.Saved = True
Case vbNo
Me.Saved = True
Case vbCancel
Cancel = True
Exit Sub
End Select
End If
On Error Resume Next
'RestoreToolBars
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As
Boolean)
Dim sFile

Application.EnableEvents = False
Cancel = True
On Error Resume Next
If SaveAsUI Then
Do
Err.Clear
sFile = Application.GetSaveAsFilename(ThisWorkbook.Name, "Excel
Files (*.xls), *.xls")
If Err.Number < 0 Then
Err.Raise (Err.Number)
GoTo Workbook_BeforeSave_Exit
End If
If sFile < False Then
ThisWorkbook.SaveAs sFile
Else
GoTo Workbook_BeforeSave_Exit
End If
Loop Until Err.Number = 0
Else
ThisWorkbook.Save
End If
' Call SaveAgRaterAsXML(sFile)
ThisWorkbook.Saved = True
Workbook_BeforeSave_Exit:
Application.EnableEvents = True
ThisWorkbook.Saved = True
Cancel = True
End Sub





Any help would be greatly appreciated.
Regards
Tony