我有一个用户窗体,在打开“主”文件时,一旦您使用事件名称(用户窗体文本框)中的名称填写了用户窗体,它就会重命名该文件。我会遇到的问题是,如果有人使用了您无法使用的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
答案 0 :(得分:2)
您需要一个函数,该函数可以检查给定的字符串是否包含多个禁用字符中的任何一个。实现此目的的一种方法是定义一个包含这些字符一次的字符串,然后迭代该字符串中的每个字符并验证输入是否包含该字符-并在我们知道答案后立即进行纾困:
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
任何没有结构的平凡对话框,都会很快变成一大堆意大利面混乱-无论是由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
您还可以使用更深思熟虑的数据验证机制来获得更细粒度的验证错误元数据。例如,模型验证错误可能不仅仅是对象,而不仅仅是普通字符串,它具有ErrorMessage
,ViewControlName
和ModelPropertyName
属性,这些属性使附加特定的验证更加容易表单上特定控件的错误,例如,如果您要红色突出显示所涉及的字段,将其聚焦,或将可爱的红色小“ 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