Question

您好我有一个按钮，允许我的老板根据他对工作表名称的输入删除工作簿中的多张工作表中的一张。此删除工作表按钮受密码保护，因为其他人使用我不希望他们删除任何内容的工作簿。

现在这并不妨碍他们右键单击特定工作表并删除，因此我需要一种方法来在未按下删除工作表按钮时保护所有工作表，并在正确输入该按钮的密码后对所有工作表进行UNPROTECT ，，因为该按钮无法删除受保护的工作表。

删除工作表按钮代码：

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

之前的版本

首先添加模块名称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

Worksheet类的事件BeforeDelete没有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

请注意，此解决方案甚至不需要保护工作簿，它只保护给定的工作表。

保护特定的表单按钮？

2 个答案: