Защитите специальную кнопку листа?

Question

Привет У меня есть кнопка, которая позволяет моему боссу удалить 1 из многих листов в книге на основе его ввода имени листа. Эта кнопка «Удалить лист» защищена паролем, так как другие люди используют книгу, я бы не хотел, чтобы они удаляли что-либо.

Теперь это не мешает им щелкнуть правой кнопкой мыши на конкретном листе и удалить его, поэтому мне нужен способ ЗАЩИЩАТЬ все листы, когда кнопка «Удалить лист» не нажата, и НЕ УДАЛЯЙТЕ все листы, как только вводится пароль для этой кнопки правильно, , так как кнопка не может удалить защищенный лист.

Удалить лист Кнопка Код:

Private Sub CommandButton4_Click() 

Dim delSheet As String 
Dim response As String 
Dim SheetFound As Boolean 
Dim MyPass As String 
Dim MyPasswrd As String, answ As String 

MyPasswrd = "test"                'password verification puts trigger in cell A100, an deletes when file close 
If Range("A101").Value <> "OK" Then 
    answ = InputBox("Please Enter The Password To Continue.", "Enter Password") 
     If answ <> MyPasswrd Then 
      MsgBox "Incorrect Password!", vbExclamation, "Warning" 
      Exit Sub 
     End If 
    Range("A101").Value = "OK" 
End If 

delSheet = InputBox("Please Enter The LAST NAME Of The DTS You Want To Remove", "Remove A DTS")      'user input 

If delSheet = "" Then 
MsgBox "You Did Not Complete The Entry.", vbOKOnly + vbInformation, "Warning"      'if NULL input displays this message 
Exit Sub 

Else 
    If IsLetter(delSheet) = False Then GoTo Display             'checks the user input 

response = MsgBox("WARNING!! This Action Cannot Be Undone, Do You Still Want To Continue?", vbExclamation + vbYesNo, "Warning")  'verfies user input 


If response = vbYes Then                'if input is yes selects sheet IF ITS FOUND 
On Error Resume Next 

     ActiveWorkbook.Sheets(delSheet).Select 
     If Err = 0 Then SheetFound = True            'searches for sheet 

    On Error GoTo 0 

    If SheetFound = False Then              'if sheet not found displays this message 

     MsgBox prompt:="The sheet '" & delSheet & "' Could Not Be Found In This File!", Buttons:=vbExclamation, Title:="Search Result" 
     Exit Sub 

    Else 

Application.DisplayAlerts = False             'Finally deletes sheet and bypass xcel warning for sheet deletion 
Sheets(delSheet).Delete 
Application.DisplayAlerts = True 

MsgBox ("The DTS " & delSheet & " Was Successfully Removed")         'message for sucessfully deleting the sheet 
Application.Goto Reference:=Worksheets("Control Center").Range("B1"), Scroll:=True 
End If 

Else 

response = vbNo                   'if user does not want to delete sheet exits window 
Exit Sub 

Display: 
    MsgBox "Invalid Character In Last Name. Please Only Use Letters And Numbers(1-9), NOT Spaces and Specail Characters (! @ # $ %^& * - + = \ _ .)", vbExclamation, "Warning" 

End If 
End If 
End Sub 

Answer 1

Если у вас есть Excel-2013 или Excel-2016 то, вы можете использовать Workbook_SheetBeforeDelete событие. В модуле рабочей книги добавьте этот код:

Option Explicit 

Public IsPasswordOK As Boolean 
Public IsDeleteOK As Boolean 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    If Not IsDeleteOK Then 
     MsgBox "You deleted a sheet without permission. Can't save the file." 
     Cancel = True 
    End If 
End Sub 

Private Sub Workbook_Open() 
    IsDeleteOK = True 
End Sub 

Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object) 
    If IsDeleteOK Then 
     IsDeleteOK = IsPasswordOK 
    End If 
End Sub 

---

В вашем CommandButton4_Click() код после строки Sheets(delSheet).Delete добавить эту строку

ThisWorkbook.IsPasswordOK=True 

---

Для версии до Excel-2013

F Сначала добавьте имя модуля mdlSheetWatch. Добавьте следующий код в этот модуль.

Option Explicit 

Public IsPasswordOK As Boolean 
Public dctSheets 
Public Function IsSheetsOk() 

    Dim wks As Worksheet 
    Dim lCtr As Long 
    Dim bResult As Boolean 

    If IsPasswordOK Then 
     bResult = True 
     Exit Function 
    Else 

     bResult = True 
     For Each wks In ThisWorkbook.Worksheets 
      If Not dctSheets.exists(wks.CodeName) Then 
      bResult = False 
      Exit For 
      End If 
     Next 

    End If 

    IsSheetsOk = bResult 

End Function 

Public Function LoadSheetList() As Object 
    Dim wks As Worksheet 
    Dim dctTemp As Object 

    Set dctTemp = CreateObject("Scripting.Dictionary") 

     For Each wks In ThisWorkbook.Worksheets 
     dctTemp.Add wks.CodeName, wks.Name 
     Next 

    Set LoadSheetList = dctTemp 

End Function 

---

Теперь в модуле рабочей книги, добавьте следующий код

Option Explicit 

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    If Not mdlSheetWatch.IsSheetsOk Then 
     MsgBox "You deleted/renamed a sheet without permission. Can't save the file." 
     Cancel = True 
    End If 
End Sub 

Private Sub Workbook_Open() 
    Set dctSheets = mdlSheetWatch.LoadSheetList 
End Sub 

---

Наконец, в вашем CommandButton4_Click() кода после строки Sheets(delSheet).Delete добавить эту строку

mdlSheetWatch.IsPasswordOK=True

---

Это должно помешать пользователям без пароля сохранить книгу после удаления/переименования/добавления листа.

Answer 2

Событие BeforeDelete класса Worksheet не имеет опции Cancel, но это обходное решение для выполнения операции отмены.

1- В обычном модуле, поместите эту рутинную:

Sub unprotectThis() 
    ThisWorkbook.unprotect 
End Sub 

2- В коде модуля листа, который вы хотите защитить от удаления, добавить этот обработчик событий:

Private Sub Worksheet_BeforeDelete() 
    ThisWorkbook.Protect 
    MsgBox "This sheet can be deleted only by the administrator through the dedicated button", vbExclamation 
    Application.OnTime Now + TimeSerial(0, 0, 1), "unprotectThis" 
End Sub 

У нас есть как-то «имитировано» Отмена. Через секунду книга снова будет незащищенной.

3- Наконец, в обработчике кнопки, где вы запрашиваете пароль, просто отключите события до фактического выполнения удаления. Это не вызовет вышеупомянутый обработчик Worksheet_BeforeDelete. Восстановление событий назад перед отъездом:

Private Sub CommandButton4_Click() 
    On Error goto RestoreEvents 
    Application.EnableEvents = false 
    ... 
    ' your routine that checks for password and performs the delete... 
    ... 
RestoreEvents: 
    Application.EnableEvents = true 
End Sub 

Обратите внимание, что это решение даже не требует, чтобы защитить книгу, он только защищает данную таблицу.