VBA代码来保护所有工作表的响应

要删除名称并关联我的工作簿的每一页上同一行中的数据，用户需要突出显示一个名称，然后单击第一个工作表上的一个button。 然后popup一个确认窗口询问他们是否确定。 如果他们点击NO，一切都会保护，并正常工作。 如果点击是，则所有工作表都不受保护，出现第二个确认窗口 – 如果第二次点击“是”，则从每个工作表中删除数据，删除后所有数据都将被保护。 但是，如果第二次点击“否”，那么在退出子文件之前，我无法获得我的代码，然后保护所有内容。

任何帮助表示赞赏，以及build议资源，以帮助成为我自己更精通。 🙂

这里是代码：

Sub DeleteRow() 'this macro deletes the row for a selected patient from worksheet of selected month and all months after that 'variables Dim PatientName As String, PatientRow As Long, w As Long Dim pRow As Long, lRow As Long, LookUpRng As Range, answer As Long Dim rArray() As Variant, sArray As Variant ReDim rArray(0) ReDim sArray(0) With ActiveSheet ActiveSheet.Unprotect "arafluid" PatientName = .Range("d" & ActiveCell.Row) PatientRow = ActiveCell.Row .Rows(PatientRow).Interior.ColorIndex = 4 'check that user want has selected correct patient answer = MsgBox("Do you want to permanently remove patient " & vbCr & vbCr & _ PatientName & " from ALL months in this workbook?", vbYesNo, "Confirmation") .Rows(PatientRow).Interior.ColorIndex = -4142 If answer = vbNo Then ActiveSheet.Protect "arafluid" If answer <> vbYes Then Exit Sub 'check that it is safe to delete rows in future sheets For w = Worksheets.Count To ActiveSheet.Index Step -1 With Sheets(w) Sheets(w).Unprotect "arafluid" pRow = 0 lRow = .Range("d10").CurrentRegion.Rows.Count + 9 Set LookUpRng = .Range("d10" & ":d" & lRow) On Error Resume Next pRow = Application.WorksheetFunction.Match(PatientName, LookUpRng, 0) + 9 If Err.Number <> 0 Then Trail = Trail & vbCr & " " & .Name & " Not Found!" Else Trail = Trail & vbCr & " " & .Name & " ok" ' add value on the end of the arrays ReDim Preserve rArray(UBound(rArray) + 1) As Variant ReDim Preserve sArray(UBound(sArray) + 1) As Variant rArray(UBound(rArray)) = pRow sArray(UBound(sArray)) = w End If On Error GoTo 0 End With Next w 'check that user still wants to delete answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _ PatientName & vbCr, vbYesNo, "Are you sure?") If answer <> vbYes Then Exit Sub If answer <> vbNo Then For a = Worksheets.Count To ActiveSheet.Index Step -1 Sheets(a).Protect "arafluid" Next a End If 'delete rows for selected patient For d = 1 To UBound(sArray) Sheets(sArray(d)).Rows(rArray(d)).EntireRow.Delete Next d End With 'loop through all sheets in the workbook. For w = 1 To Sheets.Count Sheets(w).Protect "arafluid" Next w End Sub 

Answer 1

如果用户说“不”，你退出Sub。 在第二个MessageBox之后更改这些行：

 answer = MsgBox("Once deleted, the information cannot be recovered. Click YES to permanently remove: " & vbCr & vbCr & _ PatientName & vbCr, vbYesNo, "Are you sure?") If answer = vbNo Then 'This will test if user said "No" and will protect the sheets For a = Worksheets.Count To ActiveSheet.Index Step -1 Sheets(a).Protect "arafluid" Next a Exit Sub End If 

注意，在第一个MsgBox之后，对于同样的事情，你有两个If语句的情况相同，你可以将它们简化为：

  If answer = vbNo Then ActiveSheet.Protect "arafluid" Exit Sub End If