Switchman
10-11-2005, 04:37 PM
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 not 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.
Edit
I tried to change the code in the "CustomSave" sub from
'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.Save
to
'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.SaveAs
This gives me a runtime error if I don't save over the top of the old file. If I end the script, it will then hide the sheets and let me save as. But it will not unhide the sheets.
Thanks.
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
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.
Edit
I tried to change the code in the "CustomSave" sub from
'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.Save
to
'Hide all sheets and save workbook
Call HideAllSheets
ThisWorkbook.SaveAs
This gives me a runtime error if I don't save over the top of the old file. If I end the script, it will then hide the sheets and let me save as. But it will not unhide the sheets.
Thanks.
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