PDA

View Full Version : Solved: Read Only: Disable opening/or disable prompt-to-save-as?



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?

Jan Karel Pieterse
11-06-2009, 01:20 AM
I guess:

Private Sub Workbook_Open()
If ThisWorkbook.Readonly Then
Msgbox "File open elsewhere; locate and close original file before proceeding."
Thisworkbook.Close False
End If
'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

Gingertrees
11-06-2009, 06:08 AM
Though that code worked in a test WB, when I added it to a copy of the original, it did the same as my other attempts: prevented opening as Read Only, but ignored the code to force macros enabling (Eep!!) Maybe the workbook will help. I've attached my workbook with Jan's version of Workbook_Open.

(note, had to delete a few worksheets to make even the Zip file small enough for uploading...but the sheets deleted didn't have much code to them, so I hope that doesn't affect things)

Jan Karel Pieterse
11-06-2009, 07:51 AM
For me, if I try to open the file TWICE, the second time I get the message box and then the file closes itself. Is that not what you wanted???

Gingertrees
11-06-2009, 07:53 AM
Nevermind - Jan's code DID work, once I moved it from Open_Workbook to HideSheets. So Open_workbook is back to as I originally posted, and Hidesheets now shows:
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
If ThisWorkbook.ReadOnly Then
MsgBox "File open elsewhere; locate and close original file before proceeding."
ThisWorkbook.Close False
Exit Sub
End If
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
Thanks Jan, I couldn't have done this without your help. :-)

Gingertrees
11-06-2009, 09:04 AM
Jan,
The complexity of my original workbook was a factor here. Yes, it did do what you said. However placing it in the Workbook_Open sub caused an undesirable side effect: it overrode other code, without which a user could open the workbook with macros disabled. If that occurs, read-only is the least of our worries.
Nonetheless, your code worked when placed in a different sub, so all is well.