vbaで有効性確認を保存する前に

Question

特定の列にデータがない場合、保存を停止するデータ検証が実行されています。しかし、それは動作していません。なぜ私は考えていない。コードは以下の通りです： 誰かが見てもらえると感謝しています。 また、紛失したデータセルをフィルタリングして色分けすると、簡単に識別できます。ありがとうございました！！！

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
ThisWorkbook.Worksheets("codes").Unprotect Password:="000" 

Dim Rng As Range 
Dim wb As Workbook 
Dim MyWb As Worksheet 
Dim i As Long 
Dim lrow As Long 
Const rowno = 8 
Const colno = 1On Error GoTo exitHandler 
Set Rng = Cells.SpecialCells(xlCellTypeAllValidation) 
If Rng Is Nothing Then GoTo exitHandler 
    If Not Intersect(Target, Rng) Is Nothing Then 
     Else 
     Application.EnableEvents = False 

     Set wb = ActiveWorkbook 
     Set MyWb = ThisWorkbook.Worksheets("codes") 
     lrow = MyWb.Cells(Rows.Count, colno).End(xlUp).Row 
     Start = Cells(rowno, colno) 

     For i = 8 To lrow 
     If IsEmpty(MyWb.Range("A" & i)) Or IsEmpty(MyWb.Range("B" & i)) Or IsEmpty(MyWb.Range("E" & i)) Or IsEmpty(MyWb.Range("F" & i)) Or IsEmpty(MyWb.Range("G" & i)) Or IsEmpty(MyWb.Range("H" & i)) Or IsEmpty(MyWb.Range("J" & i)) Or IsEmpty(MyWb.Range("K" & i)) Or IsEmpty(MyWb.Range("L" & i)) Or IsEmpty(MyWb.Range("N" & i)) Or IsEmpty(MyWb.Range("O" & i)) Or IsEmpty(MyWb.Range("P" & i)) Or IsEmpty(MyWb.Range("R" & i)) Or IsEmpty(MyWb.Range("T" & i)) Or IsEmpty(MyWb.Range("U" & i)) Or IsEmpty(MyWb.Range("X" & i)) Then 
      Dim missdata 
      missdata = MsgBox("You will need to enter topics before saving", vbOKOnly, "Missing data") 
      Cancel = True 
      Exit For 
     End If 
    End If 
End If 
Next i '?????? 
exitHandler: 
Application.EnableEvents = True 
ThisWorkbook.Worksheets("codes").Protect Password:="000" 
End Sub 

Answer 1

あなたはそれを試すことができます。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Dim sh As Worksheet 
    Dim rng As Range 
    Dim SelectedRange As Range 
    Dim LastRow As Long 

    Application.EnableEvents = False 

    Set sh = ThisWorkbook.Sheets("codes") 
    sh.Unprotect Password:="000" 

    LastRow = sh.Range("A" & Rows.Count).End(xlUp).Row 

    Set SelectedRange = sh.Range("A8:B" & LastRow & ", E8:H" & LastRow & ", J8:L" & LastRow & ", N8:P" & LastRow & ", R8:R" & LastRow & ", T8:U" & LastRow & ", X8:X" & LastRow) 

    For Each rng In SelectedRange 
     If rng.Value = "" Then 
      Cancel = True 
      rng.Interior.ColorIndex = 3 'Here the code will fill de cell with color red 
     End If 
    Next rng 

    If Cancel Then MsgBox "You will need to enter topics before saving", vbOKOnly, "Missing data" 

    Application.EnableEvents = True 
    sh.Protect Password:="000" 
End Sub