用户表单中的数据验证不允许/ \:*? “ <> |用于文本框

时间:2019-07-02 14:31:06

标签: excel vba userform

我有一个用户窗体,在打开“主”文件时,一旦您使用事件名称(用户窗体文本框)中的名称填写了用户窗体,它就会重命名该文件。我会遇到的问题是,如果有人使用了您无法使用的9个字符中的1个,则我有一个错误处理程序,不允许您保存...。我希望他们在用户窗体上不能继续操作,直到他们已经正确命名了他们的事件。

下面是用于提交数据的按钮单击。我认为验证应包含在“ Me.TextBoxE_EventName.Value”中……关于我可以在其中添加的任何想法?

Private Sub CommandButton_ECancelREV_Click()

'----------------------------------------------------
'Check Validation of Completed form
'----------------------------------------------------
If Trim(Me.TextBoxE_RequestBy.Value) = "" Then
    Me.TextBoxE_RequestBy.SetFocus
    MsgBox "Please fill in 'Request By' before canceling form", vbCritical
        Exit Sub
End If

If Trim(Me.TextBoxE_OnSiteContact.Value) = "" Then
    Me.TextBoxE_OnSiteContact.SetFocus
    MsgBox "Please fill in 'On Site Contact' before canceling form", vbCritical
        Exit Sub
End If

If Trim(Me.TextBoxE_OnSiteNumber.Value) = "" Then
    Me.TextBoxE_OnSiteNumber.SetFocus
    MsgBox "Please fill in 'On Site Phone Number' before canceling form"
    Exit Sub
End If

If Trim(Me.TextBoxE_EventName.Value) = "" Then
    Me.TextBoxE_EventName.SetFocus
    MsgBox "Please fill in 'Event Name' before canceling form"
    Exit Sub
End If

If Trim(Me.ComboBoxE_LocationNumber.ListIndex) = -1 Then
  Me.ComboBoxE_LocationNumber.SetFocus
  MsgBox "Please fill in 'Location Number' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_OffSiteDelivery.ListIndex) = -1 Then
  Me.ListBoxE_OffSiteDelivery.SetFocus
  MsgBox "Please fill in 'Off Site Delivery?' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_RequestStatus.ListIndex) = -1 Then
  Me.ListBoxE_RequestStatus.SetFocus
  MsgBox "Please fill in 'Request Status' before canceling form"
  Exit Sub
End If

If Trim(Me.TextBoxE_DeliverDate.Value) = "" Then
  Me.TextBoxE_DeliverDate.SetFocus
  MsgBox "Please fill in 'Delivery Date' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_DeliverTime.ListIndex) = -1 Then
  Me.ListBoxE_DeliverTime.SetFocus
  MsgBox "Please fill in 'Delivery Time' before canceling form"
  Exit Sub
End If

If Trim(Me.TextBoxE_SSDate.Value) = "" Then
  Me.TextBoxE_SSDate.SetFocus
  MsgBox "Please fill in 'Show Start Date' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_SSTime.ListIndex) = -1 Then
  Me.ListBoxE_SSTime.SetFocus
  MsgBox "Please fill in 'Show Start Time' before canceling form"
  Exit Sub
End If

If Trim(Me.TextBoxE_SEDate.Value) = "" Then
  Me.TextBoxE_SEDate.SetFocus
  MsgBox "Please fill in 'Show End Date' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_SETime.ListIndex) = -1 Then
  Me.ListBoxE_SETime.SetFocus
  MsgBox "Please fill in 'Show End Time' before canceling form"
  Exit Sub
End If

If Trim(Me.TextBoxE_PickupDate.Value) = "" Then
  Me.TextBoxE_PickupDate.SetFocus
  MsgBox "Please fill in 'Pickup Date' before canceling form"
  Exit Sub
End If

If Trim(Me.ListBoxE_PickupTime.ListIndex) = -1 Then
  Me.ListBoxE_PickupTime.SetFocus
  MsgBox "Please fill in 'Pickup Time' before canceling form"
  Exit Sub
End If

    Me.Hide
    ThisWorkbook.Sheets("Equipment Request").Visible = True
    ThisWorkbook.Sheets("Equipment Request").Select

End Sub

Private Sub E_EnterInformation_Click()

'----------------------------------------------------
'Check Validation of Completed form
'----------------------------------------------------
If Trim(Me.TextBoxE_RequestBy.Value) = "" Then
    Me.TextBoxE_RequestBy.SetFocus
    MsgBox "Please fill in 'Request By' on form", vbCritical
        Exit Sub
End If

If Trim(Me.TextBoxE_OnSiteContact.Value) = "" Then
    Me.TextBoxE_OnSiteContact.SetFocus
    MsgBox "Please fill in 'On Site Contact' on form", vbCritical
        Exit Sub
End If

If Trim(Me.TextBoxE_OnSiteNumber.Value) = "" Then
    Me.TextBoxE_OnSiteNumber.SetFocus
    MsgBox "Please fill in 'On Site Phone Number' on form"
    Exit Sub
End If

If Trim(Me.TextBoxE_EventName.Value) = "" Then
    Me.TextBoxE_EventName.SetFocus
    MsgBox "Please fill in 'Event Name' on form"
    Exit Sub
End If

If Trim(Me.ComboBoxE_LocationNumber.ListIndex) = -1 Then
  Me.ComboBoxE_LocationNumber.SetFocus
  MsgBox "Please fill in 'Location Number' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_OffSiteDelivery.ListIndex) = -1 Then
  Me.ListBoxE_OffSiteDelivery.SetFocus
  MsgBox "Please fill in 'Off Site Delivery?' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_RequestStatus.ListIndex) = -1 Then
  Me.ListBoxE_RequestStatus.SetFocus
  MsgBox "Please fill in 'Request Status' on form"
  Exit Sub
End If

If Trim(Me.TextBoxE_DeliverDate.Value) = "" Then
  Me.TextBoxE_DeliverDate.SetFocus
  MsgBox "Please fill in 'Delivery Date' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_DeliverTime.ListIndex) = -1 Then
  Me.ListBoxE_DeliverTime.SetFocus
  MsgBox "Please fill in 'Delivery Time' on form"
  Exit Sub
End If

If Trim(Me.TextBoxE_SSDate.Value) = "" Then
  Me.TextBoxE_SSDate.SetFocus
  MsgBox "Please fill in 'Show Start Date' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_SSTime.ListIndex) = -1 Then
  Me.ListBoxE_SSTime.SetFocus
  MsgBox "Please fill in 'Show Start Time' on form"
  Exit Sub
End If

If Trim(Me.TextBoxE_SEDate.Value) = "" Then
  Me.TextBoxE_SEDate.SetFocus
  MsgBox "Please fill in 'Show End Date' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_SETime.ListIndex) = -1 Then
  Me.ListBoxE_SETime.SetFocus
  MsgBox "Please fill in 'Show End Time' on form"
  Exit Sub
End If

If Trim(Me.TextBoxE_PickupDate.Value) = "" Then
  Me.TextBoxE_PickupDate.SetFocus
  MsgBox "Please fill in 'Pickup Date' on form"
  Exit Sub
End If

If Trim(Me.ListBoxE_PickupTime.ListIndex) = -1 Then
  Me.ListBoxE_PickupTime.SetFocus
  MsgBox "Please fill in 'Pickup Time' on form"
  Exit Sub
End If

'Hide or show offsite and order number boxes

If Me.ListBoxE_OffSiteDelivery.Value = "Yes" Then
    Me.LabelE_OffSiteAdd.Visible = True
    Me.TextBoxE_OffSiteAdd.Visible = True
    Else
    EquipmentRequest.LabelE_OffSiteAdd.Visible = False
    EquipmentRequest.TextBoxE_OffSiteAdd.Visible = False
    End If

If Me.ListBoxE_OffSiteDelivery.Value = "Yes" And Me.TextBoxE_OffSiteAdd.Value = "" Then
    Me.TextBoxE_OffSiteAdd.SetFocus
    MsgBox "Please fill in 'Enter Off Site Location Name and Address' on form"
  Exit Sub
End If

If Me.ListBoxE_RequestStatus.Value <> "New" Then
    EquipmentRequest.LabelE_OrderNum.Visible = True
    EquipmentRequest.TextBoxE_OrderNum.Visible = True
    Else
    EquipmentRequest.LabelE_OrderNum.Visible = False
    EquipmentRequest.TextBoxE_OrderNum.Visible = False
    End If

If Me.ListBoxE_RequestStatus.Value <> "New" And Me.TextBoxE_OrderNum.Value = "" Then
    Me.TextBoxE_OrderNum.SetFocus
    MsgBox "Please fill in 'Enter Order/Job #' on form"
  Exit Sub
End If


'--------------------------------------------
'Enter Data in Form
'--------------------------------------------
Call UnProtectAllWorksheets

Sheets("Equipment Request").Range("C6") = Me.TextBoxE_RequestBy.Value       'Name of Requester
Sheets("Equipment Request").Range("C7") = Me.TextBoxE_OnSiteContact.Value   'Name of Contact
Sheets("Equipment Request").Range("C8") = Me.TextBoxE_OnSiteNumber.Value    'Phone Number format
Sheets("Equipment Request").Range("F11") = Me.TextBoxE_Comments.Value       'Comments (not required)

Sheets("Equipment Request").Range("I6") = Me.TextBoxE_EventName.Value       'Name of Event
Sheets("Equipment Request").Range("P24") = Me.ComboBoxE_LocationNumber.Value 'Location Number
Sheets("Equipment Request").Range("I8") = Me.ListBoxE_OffSiteDelivery.Value 'Yes or No Selection
Sheets("Equipment Request").Range("I9") = Me.ListBoxE_RequestStatus.Value   'New or revision or cancel selection

Sheets("Equipment Request").Range("C9") = Me.TextBoxE_PWDate.Value          'Short Date Format
Sheets("Equipment Request").Range("D9") = Me.ListBoxE_PWTime.Value          'Time Format
Sheets("Equipment Request").Range("C10") = Me.TextBoxE_DeliverDate.Value    'Short Date Format
Sheets("Equipment Request").Range("D10") = Me.ListBoxE_DeliverTime.Value    'Time Format
Sheets("Equipment Request").Range("C11") = Me.TextBoxE_SSDate.Value         'Short Date Format
Sheets("Equipment Request").Range("D11") = Me.ListBoxE_SSTime.Value         'Time Format
Sheets("Equipment Request").Range("C12") = Me.TextBoxE_SEDate.Value         'Short Date Format
Sheets("Equipment Request").Range("D12") = Me.ListBoxE_SETime.Value         'Time Format
Sheets("Equipment Request").Range("C13") = Me.TextBoxE_PickupDate.Value     'Short Date Format
Sheets("Equipment Request").Range("D13") = Me.ListBoxE_PickupTime.Value     'Time Format

Sheets("Equipment Request").Range("K8") = Me.TextBoxE_OffSiteAdd.Value     'Address of Offsite
Sheets("Equipment Request").Range("M9") = Me.TextBoxE_OrderNum.Value     'Order/Job # if revision
Sheets("Equipment Request").Range("D5") = Me.TextBoxE_CCEmails.Value

Call ProtectAllWorksheets

Me.Hide

Call ESaveBook

If Sheets("Equipment Request").Range("I9") <> "New" And Sheets("Equipment Request").Range("I9") <> "Dates Revision" And Sheets("Equipment Request").Range("I9") <> "Cancellation Revision" Then

ThisWorkbook.Sheets("Revised Equipment Request").Visible = True
ThisWorkbook.Sheets("Revised Equipment Request").Select

Else
ThisWorkbook.Sheets("Equipment Request").Visible = True
ThisWorkbook.Sheets("Equipment Request").Select
End If

End Sub

我认为这应该是一个嵌套的if语句,我只需要一些帮助,也许是个好方法。任何帮助将不胜感激。

下面是具有错误处理程序的“ ESaveBook”宏:

Sub ESaveBook()
'----------------------------------------------------
'Save File to Hard Drive For First Time
'----------------------------------------------------

    'Call UnProtectAllWorksheets

    Application.DisplayAlerts = False

    Dim sFile As String
    Dim sPath As String
    Dim sPS As String

    sPS = Application.PathSeparator
    sPath = Environ("UserProfile") & sPS & "Documents" & sPS & "!ERF!" & sPS & Format(Sheets("Equipment Request").Range("C10").Value, "mm.dd.yy") & " - " & Format(Sheets("Equipment Request").Range("C13").Value, "mm.dd.yy") & " " & Sheets("Equipment Request").Range("I6").Value & sPS
    CreateDirectory sPath
    If Len(Dir(sPath, vbDirectory)) = 0 Then Exit Sub   'Couldn't create the path due to invalid or inaccessible location
    sFile = Sheets("Equipment Request").Range("I6").Value & " ERF SAVED " & " " & Format(Date, "mm.dd.yy") & " " & Sheets("Equipment Request").Range("I9").Value & ".xlsm"

    ActiveWorkbook.SaveAs Filename:=sPath & sFile, FileFormat:=52

    MsgBox ("This file has been saved at 'Documents\!ERF!\") & Format(Sheets("Equipment Request").Range("C10").Value, "mm.dd.yy") & " - " & Format(Sheets("Equipment Request").Range("C13").Value, "mm.dd.yy") & " " & Sheets("Equipment Request").Range("I6").Value & ("'.  The file name is '") & sFile & ("'.  Please do not move target location of file.")

    Application.DisplayAlerts = True

    'Call ProtectAllWorksheets

End Sub

Sub CreateDirectory(ByVal arg_sFolderpath As String)

    If Len(Dir(arg_sFolderpath, vbDirectory)) = 0 Then
        Dim sPS As String
        sPS = Application.PathSeparator

        Dim sBuildPath As String
        Dim vFolder As Variant
        For Each vFolder In Split(arg_sFolderpath, sPS)
            If Len(vFolder) > 0 Then
                If Len(sBuildPath) = 0 Then sBuildPath = vFolder Else sBuildPath = sBuildPath & sPS & vFolder
                If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                    On Error Resume Next
                    MkDir sBuildPath
                    On Error GoTo 0
                    If Len(Dir(sBuildPath, vbDirectory)) = 0 Then
                        MsgBox "[" & sBuildPath & "] is either invalid or unreachable.", , "Create Directory Error"
                        Exit Sub
                    End If
                End If
            End If
        Next vFolder
    End If

End Sub

3 个答案:

答案 0 :(得分:2)

TL; DR:

您需要一个函数,该函数可以检查给定的字符串是否包含多个禁用字符中的任何一个。实现此目的的一种方法是定义一个包含这些字符一次的字符串,然后迭代该字符串中的每个字符并验证输入是否包含该字符-并在我们知道答案后立即进行纾困:

Private Function IsValidPathPartString(ByVal value As String) As Boolean
'a string is valid if it contains no characters illegal in a path/file name
    Const illegalChars = "/\:*?""<>|"
    Dim i As Long
    For i = 1 To Len(illegalChars)
        If InStr(value, Mid$(illegalChars, i, 1)) > 0 Then
            Exit Function 'implicit: false
        End If
    Next
    IsValidPathPartString = True
End Function

Model-View-Presenter

任何没有结构的平凡对话框,都会很快变成一大堆意大利面混乱-无论是由MSBA的VBA新秀,还是由WinForms或WPF(现代UI框架)的C#专业人士编写的。该问题是UI编程本质所固有的,并且不熟悉面向对象编程的VBA程序员最容易受到“智能UI”陷阱的困扰,在这种情况下,表单正在运行显示,并且所有需要发生的事情都会发生通过以下形式:立即学会它是永远不会太晚。

表单的工作是收集用户输入并显示数据。期间,结束。它所呈现的数据来自哪里,与它无关。收集后收集的数据会如何处理,也与它无关。

“智能用户界面”不是编写用户界面的唯一方法。当事情变得无足轻重时,而您的形式肯定属于那种非平凡的事物,我们需要适当的结构,以免事情迅速失控。

请注意,这是 Model-View-Presenter UI模式,它与MSForms(以及WinForms,如果您涉足.NET领域)配合得很好。

型号

具有一个“模型”类,其职责是定义表单将要处理的数据。该模型类还可以负责了解其封装的数据是否有效;在更复杂的场景中,您可以将验证接合到它自己的objets集中,但是让我们保持简单。该类可能看起来像这样(请注意专用函数,用于验证字符串是否包含路径/文件名中的非法字符):

'EquipmentRequestModel.cls
Option Explicit
Private ValidationErrors As Collection

Public RequestedBy As String
Public OnSiteContact As String
Public OnSiteNumber As String
Public EventName As String
Public LocationNumber As String
Public OffSiteDelivery As String
'...

Public Property Get IsValid() As Boolean
    Validate
    IsValid = ValidationErrors.Count = 0
End Property

Public Property Get ModelValidationErrors As Variant
    If ValidationErrors.Count = 0 Then Exit Property 'implicit vbEmpty
    ReDim errors(0 To ValidationErrors.Count - 1)
    Dim e As Long
    For e = 0 To ValidationErrors.Count - 1
        errors(e) = ValidationErrors(e + 1) 'collection indexing is 1-based
    Next
    ModelValidationErrors = errors
End Property

Private Sub Validate()
    Set ValidationErrors = New Collection
    If Not IsValidRequiredString(RequestedBy) Then OnMissingRequiredFieldError "RequestedBy"
    If Not IsValidRequiredString(OnSiteContact) Then OnMissingRequiredFieldError "OnSiteContact"
    If Not IsValidRequiredString(OnSiteNumber) Then OnMissingRequiredFieldError "OnSiteNumber"
    If Not IsValidRequiredString(EventName) Then OnMissingRequiredFieldError "EventName"
    If Not IsValidPathPartString(EventName) Then OnValidationError "Field [EventName] cannot contain characters: [/\:*?""<>|]."
    '...
End Sub

Private Function IsValidRequiredString(ByVal value As String) As Boolean
'a required string is valid if it's non-empty after stripping leading/trailing spaces
    IsValidRequiredString = Trim(value) <> vbNullString
End Function

Private Function IsValidPathPartString(ByVal value As String) As Boolean
'a string is valid if it contains no characters illegal in a path/file name
    Const illegalChars = "/\:*?""<>|"
    Dim i As Long
    For i = 1 To Len(illegalChars)
        If InStr(value, Mid$(illegalChars, i, 1)) > 0 Then
            Exit Function 'implicit: false
        End If
    Next
    IsValidPathPartString = True
End Function

Private Sub OnMissingRequiredFieldError(ByVal propertyName As String)
    OnValidationError "Required field [" & propertyName & "] is empty."
End Sub

Private Sub OnValidationError(ByVal message As String)
    ValidationErrors.Add message
End Sub

有条件地取决于此类或此类属性的值的更复杂的验证可以在此处轻松实现,并且如果视图需要额外的元数据来控制此类或此类字段是否需要可见,则模型可以公开Boolean属性。

现在,您可以拥有读取工作表并使用单元格值填充此类实例的属性的代码,或者您可以拥有读取类属性并向其填充工作表单元格的代码-这样的代码不属于该模型。

但是这样的类如何影响表单的代码隐藏?

查看

该表格需要尽早引用该模型。 MSForms的优点是您可以免费获得VB_PredeclaredId属性(它是easily abused,但这是另一个讨论),因此添加Create 工厂方法很容易就是这样:

'EquipmentRequestView.frm
Option Explicit
Private model As EquipmentRequestModel

Public Property Get EquipmentRequestModel() As EquipmentRequestModel
    Set EquipmentRequestModel = model
End Property

Public Property Set EquipmentRequestModel(ByVal value As EquipmentRequestModel)
    Set model = value
    LoadModelData
End Property

Public Function Create(ByVal viewModel As EquipmentRequestModel) As EquipmentRequestView
    Dim result As EquipmentRequestView
    Set result = New EquipmentRequestView
    Set result.EquipmentRequestModel = viewModel
    Set create = result
End Function

Private Sub LoadModelData()
'synchronize control values as per model
    Me.TextBoxE_RequestBy.Value = model.RequestBy
    Me.TextBoxE_OnSiteContact.Value = model.OnSiteContact
    '...
    ValidateForm
End Sub

该表单包含许多控件,这些控件都可以响应事件。因此,我们要做的就是处理这些控件的Change事件,并相应地更新模型:

Private Sub TextBoxE_RequestBy_Change()
    model.RequestBy = Me.TextBoxE_RequestBy.Value
    ValidateForm
End Sub

Private Sub TextBoxE_OnSiteContact_Change()
    model.OnSiteContact = Me.TextBoxE_OnSiteContact.Value
    ValidateForm
End Sub

'...

ValidateForm过程从每个控件各自的处理程序中调用,每个用户输入都使模型得到验证:

Private Sub ValidateForm()
    Dim isValidForm As Boolean
    isValidForm = model.IsValid

    'command buttons are only enabled if form is valid
    Me.E_EnterInformation.Enabled = isValidForm
    Me.CommandButton_ECancelREV.Enabled =isValidForm

    'validation errors label is only visible with invalid data
    Me.ValidationErrorsLabel.Visible = Not isValidForm
    Me.ValidationErrorsLabel.Caption = Join(model.ModelValidationErrors, vbNewLine)
End Sub

您还可以使用更深思熟虑的数据验证机制来获得更细粒度的验证错误元数据。例如,模型验证错误可能不仅仅是对象,而不仅仅是普通字符串,它具有ErrorMessageViewControlNameModelPropertyName属性,这些属性使附加特定的验证更加容易表单上特定控件的错误,例如,如果您要红色突出显示所涉及的字段,将其聚焦,或将可爱的红色小“ X”图标的可见性与图标的{{ 1}}属性-这里是极限。

就表单/视图职责而言,仅此而已。这将是您的ControlToolTip按钮的Click处理程序:

E_EnterInformation

唯一缺少的是处理Private Sub E_EnterInformation_Click() Me.Hide End Sub 事件,以便我们可以跟踪用户的意思是只是退出表单并假装他们根本不想提出它。 / p>

那么表单数据如何最终出现在工作表上?

演示者

另一个类需要负责连接点:需要在某处创建模型,初始化模型(如果需要),创建表单/将模型传递给模型,然后显示表单并确定如何处理模型。现在有效的模型数据。

QueryClose

请注意,这意味着'EquipmentRequestPresenter.cls Option Explicit Public Sub Run() Dim model As EquipmentRequestModel Set model = InitializeModel With EquipmentRequestView.Create(model) .Show 'todo: handle a user-cancelled form? UpdateWorksheet model End With End Sub Private Function InitializeModel() As EquipmentRequestModel Dim model As EquipmentRequestModel Set model = New EquipmentRequestModel 'note: should probably be "With EquipmentRequestSheet" With ActiveWorkbook.Worksheets("Equipment Request") model.RequestBy = .Range("C6").Value 'todo: name these ranges... model.OnSiteContact = .Range("C7").Value '...urgently... model.OnSiteNumber = .Range("C8").Value '...before someone inserts a row/column '... End With Set InitializeModel = model End Function Private Sub UpdateWorksheet(ByVal model As EquipmentRequestModel) 'note: should probably be "With EquipmentRequestSheet" With ActiveWorkbook.Worksheets("Equipment Request") .Unprotect .Range("C6").Value = model.RequestBy .Range("C7").Value = model.OnSiteContact .Range("C8").Value = model.OnSiteNumber '... .Protect End With End Sub 过程现在也可以使用一个ESaveBook参数,并使用model而不是model.DeliveryDate-减少了担心时间的地方工作表模板需要更改,并且在顶部添加一行,或者一列偏移所有这些单元格坐标,并弄乱了所有内容。与Range("C10")一起使用已经可以保护您的代码免于此:一个命名范围成为您的代码与实际工作表单元格之间的抽象层坐标从代码中抽象出来,从而不再需要各种“此单元格又是什么?”的代码。评论...可能不正确。

还请注意,模块和过程中的.Range("DeliveryDate")外壳为纯英语,可发音的名称,任何位置均不带下划线,无时髦前缀。不确定到处都PascalCase有什么问题。

无论如何,通过该设置,当前正在该表单上调用E的宏现在应如下所示:

.Show

最后的注释:以上所有内容均为空中代码,用于说明概念;没有一个经过任何方式的测试。

答案 1 :(得分:1)

@MathieuGuindon提供了一项长期策略,但我有另一种验证方法。

基本上,而不是在事后进行验证,首先要防止用户犯错-“ 一盎司的预防通常胜过一磅的治疗”。

在您的表单中,您可以访问许多事件处理程序。有用的是KeyPress。对于一个非常简单且混乱的示例:

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 '/ \ : * ? " < > | 
    If KeyAscii = Asc("/") or KeyAscii = Asc("\") Then
        KeyAscii = 0 ' This tells the form to ignore that input
    End If
End Sub

当然,我们可以使它更聪明:

Private Function IsBadCharacter(keyToCheck as MSForms.ReturnInteger) as Boolean
     '/ \ : * ? " < > |
    Select Case keyToCheck
        Case Asc("/"), Asc("\"), Asc(":"), Asc("*"), Asc("?"), Asc(""""), Asc("<"), Asc(">"), Asc("|")
            IsBadCharacter = True
        Case Else
            IsBadCharacter = False
    End Select
End Function

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 '/ \ : * ? " < > | 
    If IsBadCharacter(KeyAscii) Then
        KeyAscii = 0 ' This tells the form to ignore that input
    End If
End Sub

这里的另一种方法是只返回0或从IsBadCharacter中纠正KeyAscii值,但是布尔方法允许您根据需要实现其他错误处理方法。

这意味着您的某些数据验证检查在视图中,而在模型中进行的任何类似检查在此示例中都是多余的(但如果您要重用该模式,则仍然需要)。但是,简单的用户体验总是好的!

答案 2 :(得分:0)

INSTR函数与SELECT CASE TRUE一起应该对您有用

 SELECT CASE True
      CASE InStr(1,yourStringtoSearchIn, StringYouwantTofind)>0
 END SELECT

经过

测试
Private Sub dero()
    Dim this$, that$
    this = "der|p"
    that = "|"
     Select Case True
          Case InStr(1, this, that) > 0
        Debug.Print ; "foudn it"
     End Select
End Sub