PDA

View Full Version : Solved: Save & Close with criteria and prevent quit excel thru X button in the right top xls



slamet Harto
12-22-2008, 12:14 AM
Hi there,

just have two problem,

1) I have the following code to exit excel application with condition.
For instance:
we have more than 1 workbook open then want to save before close. If
the workbook name is different with current workbook opened.
what I want is to save all the workbook open with:
if the workbook is read only then ask user to save to different filename
or if the workbook open with different name with current wb open then
save the workbook

Sub ExitApps()

Dim Wb As Workbook

On Error Resume Next
Application.CommandBars("MyCommandBarName").Delete
With Application
.DisplayAlerts = False
Sheet1.Visible = xlSheetVisible
Sheets("template").Visible = xlSheetVeryHidden
.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("Formatting").Visible = True
.CommandBars("Drawing").Visible = True
.CommandBars("Standard").Visible = True
.CommandBars("Control Toolbox").Visible = False
.MoveAfterReturnDirection = xlDown
.DisplayFormulaBar = True
End With



With Application
.ScreenUpdating = False

For Each Wb In Workbooks

With Wb

If Not Wb.ReadOnly Or Wb.Name <> ThisWorkbook.Name Then
.Save
Else

.Close SaveChanges:=False
Application.Quit

End If

End With

Next Wb
Application.DisplayAlerts = False
Application.ScreenUpdating = True
Application.Quit

End With
End Sub

2) Is there a way to prevent close excel application thru X button . (the X button on the right top of excel application).
I know it can be done with userform which is declined user to close an userform. But I want to prevent the user to close the application thru "X" button in right top excel application.

Your advice would be appreciate so much.
Thanks & Rgds, Harto

Simon Lloyd
12-22-2008, 01:34 AM
This prevents the x being used:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If CloseMode = 0 Then Cancel = True
MsgBox "Please Close File using FILE > CLOSE"
End Sub

slamet Harto
12-22-2008, 08:28 AM
Hi Simon,

Thank you for your help.
It seems we need to declare closemodule as integer and put it down in workbook module.

How about Question No.1 ?

Once again thank you so much

Simon Lloyd
12-22-2008, 09:22 AM
If question 1 was clear i could probably give you an answer!

Benzadeus
12-22-2008, 11:31 AM
Didn't understando question 1 too.

slamet Harto
12-22-2008, 05:04 PM
My Apologize,

Here is the scenario.
Let say, We opened 3 workbooks which are Wb 1, Wb2 and Wb3.
I put it the VBA Code (see prev post #1) in WB1, Wb2 open as read only and Wb3 open as usual.

In the VBA Code, I want to save all workbooks before quit excel. As Wb2 open as read only then allocate to another file name.

Thank you

GTO
12-22-2008, 07:39 PM
Greetings Harto,

Is this close to what you are trying to accomplish?

Option Explicit
Sub ExitApps()
Dim Wb As Workbook
'// added //
Dim intResp As Integer
Dim strFileName As String

On Error Resume Next
Application.CommandBars("MyCommandBarName").Delete
'// Reset error handling as soon as possible, so that any possible problems //
'// farther down in code aren't "masked".
On Error GoTo 0

With Application
'// I would leave alerts on, until I really need to shut them off. //
'.DisplayAlerts = False

Sheet1.Visible = xlSheetVisible

'// 'Sheets("template").Visible = xlSheetVeryHidden' can fail if one of the //
'// other open workbooks happens to be active. In most cases, such as here, it //
'// is better to qualify or explicitly state in referring to stuff... //
ThisWorkbook.Worksheets("template").Visible = xlSheetVeryHidden

.CommandBars("Worksheet Menu Bar").Enabled = True
.CommandBars("Formatting").Visible = True
.CommandBars("Drawing").Visible = True
.CommandBars("Standard").Visible = True
.CommandBars("Control Toolbox").Visible = False
.MoveAfterReturnDirection = xlDown
.DisplayFormulaBar = True
End With


With Application
.ScreenUpdating = False

For Each Wb In Workbooks

With Wb
'// I think you want an AND rather than an OR here. //
If Not Wb.ReadOnly And Wb.Name <> ThisWorkbook.Name Then
.Save
ElseIf Not Wb.Name = ThisWorkbook.Name _
And Wb.ReadOnly = True Then
'// No reason to ask about saving as unless the read only wb has had//
'// changes made, so we'll check that first. //
If Wb.Saved = False Then
'// Change MsgBox style to suit... //
intResp = MsgBox(Wb.Name & " is a read only workbook and has" & _
" been changed. Would you like to save it" & vbCrLf & _
"with a new filename?", vbDefaultButton1 + vbYesNo, "")

'// If user chooses Yes... //
If intResp = vbYes Then
'// ...assign the return of the GetSaveAsFilename dialog to //
'// a string variable. //
strFileName = _
Application.GetSaveAsFilename( _
InitialFilename:="Copy " & Wb.Name, _
FileFilter:="Microsoft Excel Workbook (*.xls), *.xls", _
Title:="My Custom SaveAs")

'// If the user first selects <Yes> on the MsgBox, but then //
'// changes his mind and Cancels the GetSaveAsFilename, the //
'// return value will be "False". //
If Not strFileName = "False" Then
Wb.SaveAs strFileName
Wb.Close
Else
Wb.Close SaveChanges:=False
End If
Else
Wb.Close SaveChanges:=False
End If
Else
Wb.Close

End If


End If

End With

Next Wb

Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Quit

End With
End Sub
Hope this helps:thumb ,

Mark

slamet Harto
12-22-2008, 08:00 PM
Hi Mark,

Worked well.

highly appreciated it and thank you for your assistance.
Best,
Harto