応答に応じてすべてのワークシートを保護するVBAコード

Question

名前を削除し、ブックの各シートの同じ行にあるデータを関連付けるには、名前を強調表示して最初のワークシートのボタンをクリックする必要があります。確認ウィンドウが表示され、確認が表示されます。彼らが「いいえ」をクリックすると、すべてが保護され、正常に機能します。 YESをクリックすると、すべてのワークシートが保護されず、2番目の確認ウィンドウが表示されます。 - YESを2回クリックすると、データは各ワークシートから削除され、削除後はすべて保護されます。ただし、NOを2回目にクリックした場合、サブコードを終了する前にすべてを保護するコードを取得できません。

何か助けていただければ幸いです。また、自分自身でより堪能になるための参考になるリソースもあります。 :)ここで

コードです：

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

ユーザが「いいえ」と述べている場合は、サブを終了しています。第二のMessageBox後にこれらの行を変更します。

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