保护特定的表单button？
嗨，我有一个button，允许我的老板根据他的名单input删除工作簿中的许多工作表中的一个。 这个删除表button是密码保护，因为其他人使用的工作簿，我不希望他们删除任何东西。
现在这并不妨碍他们右键单击特定工作表和删除，所以我需要一种方法来保护所有的工作表，当删除工作表button没有按下，并UNPROTECT所有工作表一旦该button的密码input正确， 因为button不能删除受保护的表单 。
删除工作表button代码：
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 如果您有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
这应该防止没有密码的用户在删除/重命名/添加工作表后保存工作簿。
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-最后，在button的处理程序中，要求input密码，只需在实际执行删除之前禁用事件。 这不会调用上面的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
请注意，此解决scheme甚至不需要保护工作簿，它只保护给定的工作表。