Test force me

[Switchman]

This is a test

Option Explicit

Const WelcomePage = "Notice"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'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
'----> Cancel = True


'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_Open()

'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True


' Go to the Intstructions Tab.
Call Tab_Instructions

End Sub

Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub


Sub CustomSave()
Dim ws As Worksheet, aWs As Worksheet
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.Save

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

[Switchman]

[VBA] Option Explicit

Const WelcomePage = "Notice"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'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
'----> Cancel = True


'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_Open()


'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True


' Go to the Intstructions Tab.
Call Tab_Instructions

End Sub

Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub


Sub CustomSave()
Dim ws As Worksheet, aWs As Worksheet
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.Save

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub[/VBA]

[Switchman]

I would like to first of all thank every one for all of the helpful information that they have posted to this site. I recently found the site while trying to develop some Excel scripts for a spreadsheet I am building. First of all let me point out I am knot a ?coder? I can follow code to degree and modify other peoples work/system generated code to a limited degree. So it was nice to find this site with all of the documented code samples. Now on to my problem.

I found the KB entry, Force User to Enable Macros at http://vbaexpress.com/kb/getarticle.php?kb_id=578. I was unable to get it to work. I then found this thread in the forum. I have put the original code at the top of the thread with the fixes. While it works there is one problem, I cannot do a ?Save As? command from in the worksheet when I run this code. Does any one have any thoughts of the changes that could be made to allow a ?Save As? command. The only change I made was to declare the sheet name as ?Notice? versus ?Macros? in the original code.
Below is the full code reposted as a complete entity.

Thanks.

[VBA] Option Explicit

Const WelcomePage = "Notice"

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'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
Cancel = True


'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True

End Sub

Private Sub Workbook_Open()

'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True


' Go to the Intstructions Tab.
Call Tab_Instructions

End Sub

Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub


Sub CustomSave()
Dim ws As Worksheet, aWs As Worksheet
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.Save

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

[/VBA]