Gingertrees
11-04-2009, 03:32 PM
Aagghhh! This USED to show just "Prompt" sheet when user disables macros...now it can show "Hub" and "Cases" sheets (which I want only visible if macros Enabled).:banghead:
(Force macros routine courtesy johnske/KBase, http://vbaexpress.com/kb/getarticle.php?kb_id=578 )
NOTE: I think I probably screwed up in Private Sub UnhideSheets (near bottom), when I tried to change it to show "Hub and "Cases" instead of all sheets NOT "Prompt."
Please help:
' MODULE: ThisWorkbook
Option Explicit
'passwords for most sheets="cap", background="CAP", Cases="jaeger"
Dim bolMyOverride As Boolean
'// BeforeClose and Open remain as you had them, as do the proedures 'HideSheets' and //
'// 'UnhideSheets'. //
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call HideSheets
.ScreenUpdating = True
.EnableCancelKey = xlInterrupt
End With
End Sub
Private Sub Workbook_Open()
'this is located in the ThisWorkbook module
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
End Sub
Private Sub Workbook_Activate()
'// After you have run 'EnableStuffSoICanWork()', then the Boolean 'bolMyOverride' //
'// equals TRUE. //
'// So... assuming you've run the aforementioned sub and bolMyOverride has been set //
'// to True, the below test fails, and 'CutCopy_Disable' is never called. In short,//
'// as long as bolMyOverride retains a value of True, you can make mods w/o //
'// interference, as long as you don't reset. //
If Not bolMyOverride Then
'// Code moved to own sub //
Call CutCopy_Disable
End If
End Sub
Private Sub Workbook_Deactivate()
'// SAA //
If Not bolMyOverride Then
Call CutCopy_Enable
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not bolMyOverride Then
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End If
End Sub
Private Sub MakeBackgroundVisible()
Sheet16.Visible = xlSheetVisible
End Sub
Private Sub EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
End Sub
Private Sub DisableStuffSoOthersCannotGooberUpMyDay()
Call CutCopy_Disable
bolMyOverride = False
'// Optional of course //
ThisWorkbook.Save
End Sub
Private Sub CutCopy_Disable()
Dim oCtrl As Office.CommandBarControl
'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl
'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl
Application.CellDragAndDrop = False
End Sub
Private Sub CutCopy_Enable()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl
'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl
Application.CellDragAndDrop = True
End Sub
Private Sub HideSheets()
'
Dim Sheet As Object '< Includes worksheets and chartsheets
'
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A100] below bypass the "Save?" dialog...
' If ThisWorkbook.Saved = True Then .[A100] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
End Sub
Private Sub UnhideSheets()
'
Dim Sheet As Object
'
With Sheets("Hub")
With Sheets("Cases")
.Visible = xlSheetVisible
Sheets("Prompt").Visible = xlSheetVeryHidden
For Each Sheet In Sheets
If Sheet.Name = "Hub" Then
Sheet.Visible = xlSheetVisible
Else
If Sheet.Name = "Cases" Then
Sheet.Visible = xlSheetVisible
Else
Sheet.Visible = xlSheetHidden
End If
End If
Next
End With
End With
'
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True
End Sub
'//this is the original "UnhideSheets" from johnske.
'//I copied and commented it when I modified "UnhideSheets"
'//as above.
'Private Sub UnhideSheets()
'
' Dim Sheet As Object
'
' For Each Sheet In Sheets
' If Not Sheet.Name = "Prompt" Then
' Sheet.Visible = xlSheetVisible
' End If
' Next
'
' Sheets("Prompt").Visible = xlSheetVeryHidden
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
' Set Sheet = Nothing
' ActiveWorkbook.Saved = True
'End Sub
(Force macros routine courtesy johnske/KBase, http://vbaexpress.com/kb/getarticle.php?kb_id=578 )
NOTE: I think I probably screwed up in Private Sub UnhideSheets (near bottom), when I tried to change it to show "Hub and "Cases" instead of all sheets NOT "Prompt."
Please help:
' MODULE: ThisWorkbook
Option Explicit
'passwords for most sheets="cap", background="CAP", Cases="jaeger"
Dim bolMyOverride As Boolean
'// BeforeClose and Open remain as you had them, as do the proedures 'HideSheets' and //
'// 'UnhideSheets'. //
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Application
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call HideSheets
.ScreenUpdating = True
.EnableCancelKey = xlInterrupt
End With
End Sub
Private Sub Workbook_Open()
'this is located in the ThisWorkbook module
With Application
'disable the ESC key
.EnableCancelKey = xlDisabled
.ScreenUpdating = False
Call UnhideSheets
.ScreenUpdating = True
're-enable ESC key
.EnableCancelKey = xlInterrupt
End With
End Sub
Private Sub Workbook_Activate()
'// After you have run 'EnableStuffSoICanWork()', then the Boolean 'bolMyOverride' //
'// equals TRUE. //
'// So... assuming you've run the aforementioned sub and bolMyOverride has been set //
'// to True, the below test fails, and 'CutCopy_Disable' is never called. In short,//
'// as long as bolMyOverride retains a value of True, you can make mods w/o //
'// interference, as long as you don't reset. //
If Not bolMyOverride Then
'// Code moved to own sub //
Call CutCopy_Disable
End If
End Sub
Private Sub Workbook_Deactivate()
'// SAA //
If Not bolMyOverride Then
Call CutCopy_Enable
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not bolMyOverride Then
With Application
.CellDragAndDrop = False
.CutCopyMode = False 'Clear clipboard
End With
End If
End Sub
Private Sub MakeBackgroundVisible()
Sheet16.Visible = xlSheetVisible
End Sub
Private Sub EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
End Sub
Private Sub DisableStuffSoOthersCannotGooberUpMyDay()
Call CutCopy_Disable
bolMyOverride = False
'// Optional of course //
ThisWorkbook.Save
End Sub
Private Sub CutCopy_Disable()
Dim oCtrl As Office.CommandBarControl
'Disable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = False
Next oCtrl
'Disable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = False
Next oCtrl
Application.CellDragAndDrop = False
End Sub
Private Sub CutCopy_Enable()
Dim oCtrl As Office.CommandBarControl
'Enable all Cut menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=21)
oCtrl.Enabled = True
Next oCtrl
'Enable all Copy menus
For Each oCtrl In Application.CommandBars.FindControls(ID:=19)
oCtrl.Enabled = True
Next oCtrl
Application.CellDragAndDrop = True
End Sub
Private Sub HideSheets()
'
Dim Sheet As Object '< Includes worksheets and chartsheets
'
With Sheets("Prompt")
'
'the hiding of the sheets constitutes a change that generates
'an automatic "Save?" prompt, so IF the book has already
'been saved prior to this point, the next line and the lines
'relating to .[A100] below bypass the "Save?" dialog...
' If ThisWorkbook.Saved = True Then .[A100] = "Saved"
'
.Visible = xlSheetVisible
'
For Each Sheet In Sheets
If Not Sheet.Name = "Prompt" Then
Sheet.Visible = xlSheetVeryHidden
End If
Next
'
If .[A100] = "Saved" Then
.[A100].ClearContents
ThisWorkbook.Save
End If
'
Set Sheet = Nothing
End With
'
End Sub
Private Sub UnhideSheets()
'
Dim Sheet As Object
'
With Sheets("Hub")
With Sheets("Cases")
.Visible = xlSheetVisible
Sheets("Prompt").Visible = xlSheetVeryHidden
For Each Sheet In Sheets
If Sheet.Name = "Hub" Then
Sheet.Visible = xlSheetVisible
Else
If Sheet.Name = "Cases" Then
Sheet.Visible = xlSheetVisible
Else
Sheet.Visible = xlSheetHidden
End If
End If
Next
End With
End With
'
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
Set Sheet = Nothing
ActiveWorkbook.Saved = True
End Sub
'//this is the original "UnhideSheets" from johnske.
'//I copied and commented it when I modified "UnhideSheets"
'//as above.
'Private Sub UnhideSheets()
'
' Dim Sheet As Object
'
' For Each Sheet In Sheets
' If Not Sheet.Name = "Prompt" Then
' Sheet.Visible = xlSheetVisible
' End If
' Next
'
' Sheets("Prompt").Visible = xlSheetVeryHidden
'
' Application.Goto Worksheets(1).[A1], True '< Optional
'
' Set Sheet = Nothing
' ActiveWorkbook.Saved = True
'End Sub