如何获取Excel用户表单进行验证然后编辑用户表单

Question

我已经创建了一个用户表单，我试图使其进行验证并检查是否已输入所有字段，然后再继续将数据输入到工作表中。到目前为止，我已经有了检查这些字段并显示错误消息的代码（如果其中一个字段没有数据）。

我尝试通过使用Call函数来循环验证，首先是Data_Validation，然后是AddName_Click。他们俩都不起作用。

初始化用户窗体后，代码将移至以下子例程

Private Sub AddName_Click()


'Variable Declaration
Dim BlnVal As Boolean

'Find Last Row on Staff Data Worksheet

Dim LastRow As Long
    Dim rng As Range

   'Use a range on the sheet
    Set rng = Sheets("Staff Data").Range("A2:E900")

    ' Find the last row
    LastRow = Last(1, rng)


     'Data Validation
    Call Data_Validation


    'Find Area value
    If ARLArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "ARL"
    If LSQArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "LSQ"
    If KNBArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "KNB"
    If RSQArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "RSQ"
    If RevenueControlInspectors = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "RCI"
    If SpecialRequirementTeam = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "SRT"

    rng.Parent.Cells(LastRow + 1, 2).Value = EmployeeNo1.Value
    rng.Parent.Cells(LastRow + 1, 3).Value = FirstName1.Value
    rng.Parent.Cells(LastRow + 1, 4).Value = LastName1.Value

    'Find Grade value
    If CSA2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSA2"
    If CSA1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSA1"
    If CSS2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSS2"
    If CSS1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSS1"
    If CSM2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSM2"
    If CSM1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSM1"
    If AM = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "AM"
    If RCI = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "RCI"
    If SRT = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "SRT"

  On Error GoTo ErrOccured
    'Boolean Value
    BlnVal = 0





ErrOccured:
    'TurnOn screen updating
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'Empty Area
        ARLArea = False
        LSQArea = False
        KNBArea = False
        RSQArea = False
        RevenueControlInspectors = False
        SpecialRequirementTeam = False

    'Empty EmployeeNo1
        EmployeeNo1.Value = ""

    'Empty FirstName1
        FirstName1.Value = ""

    'Empty LastName1
        LastName1.Value = ""

    'Empty Grade
        CSA2 = False
        CSA1 = False
        CSS2 = False
        CSS1 = False
        CSM2 = False
        CSM1 = False
        AM = False
        RCI = False
        SRT = False

End Sub

如您所见，在应该进入数据验证例程以检查是否已输入所有数据之后，我已经在例程的其余部分添加了内容。数据验证例程如下所示。

Sub Data_Validation()
' Check if all data has been entered on the userform

     If ARLArea = False And KNBArea = False And LSQArea = False And RSQArea = False And RevenueControlInspectors = False And SpecialRequirementTeam = False Then
        MsgBox "Select Area!", vbInformation, ("Area")
        ARLArea.SetFocus
        Exit Sub
        End If
     If EmployeeNo1 = "" Then
        MsgBox "Enter Employee Number!", vbInformation, ("Employee Number")
        EmployeeNo1.SetFocus
        Exit Sub
        End If
     If FirstName1 = "" Then
        MsgBox "Enter First Name!", vbInformation, ("First Name")
        FirstName1.SetFocus
        Exit Sub
        End If
     If LastName1 = "" Then
        MsgBox "Enter Last Name!", vbInformation, ("Last Name")
        LastName1.SetFocus
        Exit Sub
        End If
     If CSA2 = False And CSA1 = False And CSS2 = False And CSS1 = False And CSM2 = False And CSM1 = False And AM = False And RCI = False And SRT = False Then
        MsgBox "Select Grade!", vbInformation, ("Grade")
        CSA2.SetFocus
        Exit Sub
        End If

        BlnVal = 1

End Sub

我的问题是消息出现后，然后单击“确定”。该程序将继续运行，并将现有数据输入到工作表中。我想要做的是，当错误消息出现时，单击确定，用户窗体再次生效，可以使用丢失的数据进行编辑。然后，我希望它再次验证表单，直到输入所有字段，然后再将数据传输到工作表。

Answer 1

继续执行此操作的原因是，当您退出此子程序时，它只是结束了对当前子程序的处理，而不是其他代码。

您要么需要：

1. 在下层子目录中引发错误，并在上层子目录中处理异常
2. 将此Data_Validation（）转换为可返回值的函数，例如无错误时为0或存在错误时为1
3. 只需将较大的if块移至您用来触发插入的On_Click事件。如果将代码移至主子目录，则EXIT SUB将在触发后正确踢出代码。然后将该值输入到您的上级子目录中。

最容易立即实现的方法是将Data_Validation（）转换为一个函数，并在验证完成后返回值True或False。

如果验证失败，我们将处理错误消息，并向主Sub返回FALSE值以退出该Sub，然后允许用户更新表单并再次单击按钮。我不确定您的blnVal是干什么的。可能正在尝试执行我更新了代码后要执行的操作？-但是，要使该特定版本的逻辑起作用，唯一的方法是将变量设置为public，并且这样做不被认为是一种好习惯。

请记住，如果您希望用户能够在代码处理过程中更新数据，那实际上是不可行的。您可以 在弹出窗口中创建输入框，而不是错误框，该框允许用户输入这些字段并在输入值并接受输入时继续处理代码。

Private Sub AddName_Click()


'Variable Declaration
Dim BlnVal As Boolean

'Find Last Row on Staff Data Worksheet

Dim LastRow As Long
    Dim rng As Range

   'Use a range on the sheet
    Set rng = Sheets("Staff Data").Range("A2:E900")

    ' Find the last row
    LastRow = Last(1, rng)


     'Data Validation - returns FALSE if failed, True if success
    If Data_Validation() = False Then
        Exit Sub
    End If


    'Find Area value
    If ARLArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "ARL"
    If LSQArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "LSQ"
    If KNBArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "KNB"
    If RSQArea = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "RSQ"
    If RevenueControlInspectors = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "RCI"
    If SpecialRequirementTeam = True Then rng.Parent.Cells(LastRow + 1, 1).Value = "SRT"

    rng.Parent.Cells(LastRow + 1, 2).Value = EmployeeNo1.Value
    rng.Parent.Cells(LastRow + 1, 3).Value = FirstName1.Value
    rng.Parent.Cells(LastRow + 1, 4).Value = LastName1.Value

    'Find Grade value
    If CSA2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSA2"
    If CSA1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSA1"
    If CSS2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSS2"
    If CSS1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSS1"
    If CSM2 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSM2"
    If CSM1 = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "CSM1"
    If AM = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "AM"
    If RCI = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "RCI"
    If SRT = True Then rng.Parent.Cells(LastRow + 1, 5).Value = "SRT"

  On Error GoTo ErrOccured
    'Boolean Value
    BlnVal = 0





ErrOccured:
    'TurnOn screen updating
    Application.ScreenUpdating = True
    Application.EnableEvents = True

    'Empty Area
        ARLArea = False
        LSQArea = False
        KNBArea = False
        RSQArea = False
        RevenueControlInspectors = False
        SpecialRequirementTeam = False

    'Empty EmployeeNo1
        EmployeeNo1.Value = ""

    'Empty FirstName1
        FirstName1.Value = ""

    'Empty LastName1
        LastName1.Value = ""

    'Empty Grade
        CSA2 = False
        CSA1 = False
        CSS2 = False
        CSS1 = False
        CSM2 = False
        CSM1 = False
        AM = False
        RCI = False
        SRT = False

End Sub

-

Function Data_Validation() As Boolean 'Declare Function with Bool as data type

'Default True. False if any conditions met. When a function is called, a new variable,
'with the function name and datatype given is created.  You'll set the value in the
'function.  When the function ends either in Exit Function or
'End Function, whatever is contained in this variable is returned as the Functions result
    Data_Validation = True
' Check if all data has been entered on the userform



     If ARLArea = False And KNBArea = False And LSQArea = False And RSQArea = False And RevenueControlInspectors = False And SpecialRequirementTeam = False Then
        MsgBox "Select Area!", vbInformation, ("Area")
        ARLArea.SetFocus
        Data_Validation = False
        Exit Function
        End If
     If EmployeeNo1 = "" Then
        MsgBox "Enter Employee Number!", vbInformation, ("Employee Number")
        EmployeeNo1.SetFocus
        Data_Validation = False
        Exit Function
        End If
     If FirstName1 = "" Then
        MsgBox "Enter First Name!", vbInformation, ("First Name")
        FirstName1.SetFocus
        Data_Validation = False
        Exit Function
        End If
     If LastName1 = "" Then
        MsgBox "Enter Last Name!", vbInformation, ("Last Name")
        LastName1.SetFocus
        Data_Validation = False
        Exit Function
        End If
     If CSA2 = False And CSA1 = False And CSS2 = False And CSS1 = False And CSM2 = False And CSM1 = False And AM = False And RCI = False And SRT = False Then
        MsgBox "Select Grade!", vbInformation, ("Grade")
        CSA2.SetFocus
        Data_Validation = False
        Exit Function
        End If

        BlnVal = 1


End Function