Gingertrees
11-05-2009, 02:23 PM
Everything seemed to work until I tried to disable functionality when put into Read Only mode. I found various solutions...all of which emasculated my other code. What I want: MsgBox("File open elsewhere; locate and close original file before proceeding") followed by closing the application with no option to "Save As".
My code:
' MODULE: ThisWorkbook
Option Explicit
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 EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
'bolMyOverride enables cut/copy/paste, drag cell, etc
Sheet16.Visible = xlSheetVisible
'Sheet16=background
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()
'
With ThisWorkbook
.Worksheets("Hub").Visible = xlSheetVisible
.Worksheets("Cases").Visible = xlSheetVisible
.Worksheets("Prompt").Visible = xlSheetVeryHidden
.Saved = True
End With
'
End Sub
Note: both the Workbook_BeforeSave solutions found on Mr. Excel ALMOST worked...except they overrode my "force macros" code (bad ju-ju). :
http://www.mrexcel.com/forum/showthread.php?t=399411&highlight=read+save+disable
Ideas?
My code:
' MODULE: ThisWorkbook
Option Explicit
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 EnableStuffSoICanWork()
Call CutCopy_Enable
bolMyOverride = True
'bolMyOverride enables cut/copy/paste, drag cell, etc
Sheet16.Visible = xlSheetVisible
'Sheet16=background
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()
'
With ThisWorkbook
.Worksheets("Hub").Visible = xlSheetVisible
.Worksheets("Cases").Visible = xlSheetVisible
.Worksheets("Prompt").Visible = xlSheetVeryHidden
.Saved = True
End With
'
End Sub
Note: both the Workbook_BeforeSave solutions found on Mr. Excel ALMOST worked...except they overrode my "force macros" code (bad ju-ju). :
http://www.mrexcel.com/forum/showthread.php?t=399411&highlight=read+save+disable
Ideas?