Alex,

You got me stumped.
When the button is clicked, the "ThisWorkbook.Save" code line does not execute.
The only thing I can come up with is a 'crutch' that works, but I don't know why.

Replace the code for the button...

from...
ThisWorkbook.Close
to.......
Application.CommandBars(1).FindControl(ID:=30002). Controls("&Close").Execute

Regards,
Jim Cone
San Francisco, USA


"Alex"

wrote in message
...
Thank you very much, Jim.
It's working perfectly when I tested it on a new spreadsheet. But, on my
workbook on the Main sheet I have a Close button:

Private Sub cmdClose_Click()
ThisWorkbook.Close
End Sub

Testing your code on a newly created workbook everything is perfect. But
when I'm adding this Close button (as on my app) I'm going to the loop as
well. So, I have two choices: get rid of this button or think how to incorporate
it properly. Could you advise what's wrong with this button?
Thanks
'------------------------------------------


"Jim Cone" wrote:
Alex,
Yes, that was a first impression and it wasn't good advice.
I've gone back thru the code and have rewritten it some.
I had to comment out the Hide and Show AllSheets portion
as I don't have that code.
I tried this a couple of time and it seems to work.
Note the module level variable and the error handling that
was added.
Jim Cone


'--------------------------------
Option Explicit

Private blnContinue As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Err_Handler
If blnContinue Then Exit Sub
'Evaluate if workbook is saved and emulate default prompts
If Not ThisWorkbook.Saved Then
Select Case MsgBox("Do you want to save the changes you made to " _
& ThisWorkbook.Name & "'?", vbYesNoCancel + vbExclamation)
Case vbYes
'Call customized save routine
If ActiveWorkbook.ReadOnly Then
MsgBox ("The Application is read-only. You cannot save changes.")
Else
'Turn off events to prevent unwanted loops
Application.EnableEvents = False
Call CustomSave
Application.EnableEvents = True
End If
Case vbNo
'Do not save
blnContinue = True
ThisWorkbook.Close savechanges:=False
Case vbCancel
Cancel = True
End Select
End If
Exit Sub
Err_Handler:
Application.EnableEvents = True
End Sub
'-----------
Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False
'Record active worksheet
Set aWs = ActiveSheet
'****************
' If ActiveSheet.Name < "Sheet1" Then Call HideAllSheets
'****************
'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If
'****************
'Restore file to where user was
' Call ShowAllSheets
'****************
aWs.Activate
'Restore screen updates
Application.ScreenUpdating = True
End Sub
'----------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
On Error GoTo Err_Handler
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
Exit Sub
Err_Handler:
Application.EnableEvents = True
End Sub
'-------------------------------------------------