Prevent Deletion of Sheets

[somf]

Greetings all.

I'm looking to prevent the user from deleting a specific sheet in a workbook (a change log). Protecting the workbook's structure is not an option, as the users need to be able to insert and remove their own sheets as they like.

Any ideas?

 

[Oorang]

I would protect it for structure then give the users a button to insert sheets. You could make the button unprotect the workbook insert the sheet and reprotect it.

You could go with an obvious command bar button, or you could do something more subtle like replacing the built in Insert Sheet command with your own like so:


Caution: I haven't really break-tested this, so you might want to play with it and refine it if need be.
Put the following in a standard code module:

Option Explicit
Sub EditMenu()
    On Error GoTo Err_Hnd
    Dim c As Office.CommandBarButton
    Dim cb As Office.CommandBar
    Set cb = Excel.CommandBars("Ply")
    For Each c In cb.Controls
        If c.ID = 945 Then
            c.Visible = False
            Exit For
            End If
    Next c
    Set c = cb.Controls.Add(Type:=msoControlButton, Before:=1)
    c.Caption = "&Insert Sheet..."
    c.OnAction = "InsertSheet"
    c.Visible = True
    Exit Sub
Err_Hnd:
    MsgBox Err.Description, vbCritical, "Error: " & Err.Number
    On Error Resume Next
    Set cb = Excel.CommandBars("Ply")
    cb.Reset
End Sub
Sub InsertSheet()
    'This needs to go in a module.
    On Error GoTo Err_Hnd
    If ThisWorkbook.Name = ActiveWorkbook.Name Then
        Const strPW As String = "MyPassword"
        ThisWorkbook.Unprotect Password:=strPW
        ThisWorkbook.Sheets.Add
        ThisWorkbook.Protect Password:=strPW, Structure:=True, Windows:=False
        Else
        If Not ThisWorkbook.ProtectStructure Then
            ThisWorkbook.Sheets.Add
            Else
            MsgBox "Workbook protected for structure!", vbExclamation, "Cannot Add Sheet"
            End If
    Exit Sub
Err_Hnd:
    MsgBox Err.Description, vbCritical, "Error: " & Err.Number
End Sub
Sub ResetMenu()
    On Error Resume Next
    Dim cb As Office.CommandBar
    Set cb = Excel.CommandBars("Ply")
    cb.Reset
End Sub

Put this in your thisworkbook module:

Option Explicit
Private Sub Workbook_Open()
EditMenu
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ResetMenu
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
ResetMenu
End Sub
Private Sub Workbook_Activate()
EditMenu
End Sub
Private Sub Workbook_Deactivate()
ResetMenu
End Sub

 

[somf]

Thanks for that Oorang.

It looks good, but I am working with restriction where I can not put anything into new modules - it all has to be in the ThisWorkbook module. Also, I am looking to minimize the impact this will have on the user. If it were one workbook, I would consider implementing what you have suggested, but this is going to be rolled out to over a hundred workbooks internationally, so if we change anything about how Excel operates (like how to insert new worksheets), we kind of have to retrain them.

The solution I have come up with is that each time the user moves the selection, the SelectionChange event tests for the presence of the change log. If it's not there, the user is informed "You have removed the change log. This action is not permitted as it circumvents change tracking. This workbook will now close without saving.", and the workbook closes. It's not the ideal solution (ideally, Excel would have a BeforeSheetDeletion event, which I would use), but it will work OK.

Thanks anyway!

Rob