我的代码作为Doug Glancys 建议的扩展。
该解决方案使用每个文本框的标记属性。
''
' Validate all textboxes in the userform
'
Private Sub Validate()
Dim cntrol As Control
Dim msgText As String
'loop through all the controls
For Each cntrol In Me.Controls
'check to see if it is a textbox
If TypeOf cntrol Is MSForms.TextBox Then
Dim tBox As MSForms.TextBox
Set tBox = cntrol
'we have a textbox so validate the entry
If validateTextBox(tBox, msgText) Then
' did not validate so set focus on the control
' select control
selectControl cntrol
MsgBox msgText, vbCritical + vbOKOnly, "Invalid Data"
'release the object
Set tBox = Nothing
'exit as we do not need to process further
Exit Sub
End If
Set tBox = Nothing
End If
Next
End Sub
''
' validate a textbox's value and return true or false
'
' tb is a textbox control
' msgText is a return variable holding the message text
'
Private Function validateTextBox(tb As MSForms.TextBox, Optional ByRef msgText As Variant) As Boolean
' constants for tag-information
Const TAG_VALIDATE_OPEN = "[validate:"
Const TAG_VALIDATE_CLOSE = "]"
Const TAG_VALIDATE_DATA_OPEN = "{"
Const TAG_VALIDATE_DATA_CLOSE = "}"
' variables
Dim sValue As String
Dim isValid As Boolean
Dim pos1 As Long
Dim pos2 As Long
Dim vSpec As String
Dim VSpecData() As String
Dim VSpecDataDefined As Boolean
VSpecDataDefined = False
isValid = False
sValue = Trim(tb.text)
'
' analyse tag-string and get specifications.
' Syntax for tag is [validate:command{data1,data2,data3}]
'
pos1 = InStr(1, LCase(tb.Tag), LCase(TAG_VALIDATE_OPEN))
If pos1 > 0 Then
pos2 = InStr(pos1 + Len(TAG_VALIDATE_OPEN), tb.Tag, TAG_VALIDATE_CLOSE)
vSpec = Mid(tb.Tag, pos1 + Len(TAG_VALIDATE_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_OPEN)))
pos1 = InStr(1, vSpec, TAG_VALIDATE_DATA_OPEN)
If pos1 > 0 Then
pos2 = InStr(pos1, vSpec, TAG_VALIDATE_DATA_CLOSE)
VSpecDataDefined = True
VSpecData = Split(Mid(vSpec, pos1 + Len(TAG_VALIDATE_DATA_OPEN), pos2 - (pos1 + Len(TAG_VALIDATE_DATA_OPEN))), ",")
vSpec = Left(vSpec, pos1 - 1)
End If
End If
'
' Handle validation as specified
'
Select Case vSpec
Case "numeric"
If VSpecDataDefined Then
On Error Resume Next
Dim d As Double
Dim dLower As Double
Dim dUpper As Double
d = CDbl(sValue)
If Err.number <> 0 Then
isValid = False
Else
msgText = "Zahl"
isValid = True
' lower bound
If UBound(VSpecData) >= 0 Then
Select Case VSpecData(0)
Case "", "inf", "-inf"
Case Else
dLower = CDbl(VSpecData(0))
msgText = msgText & vbcrlf & " >= " & dLower
isValid = isValid And d >= dLower
End Select
End If
' upper bound
If UBound(VSpecData) >= 1 Then
Select Case VSpecData(0)
Case "", "inf", "-inf"
Case Else
dUpper = CDbl(VSpecData(1))
msgText = msgText & vbcrlf & " <= " & dUpper
isValid = isValid And d <= dUpper
End Select
End If
End If
Else
msgText = "Zahl"
isValid = IsNumeric(sValue)
End If
Case Else
isValid = True
End Select
'
' return : true if invalid
' false if valid
'
validateTextBox = Not isValid
End Function
''
' common function to select a textbox and set focus to it
' even if it sits on a page of a multipage control
'
Private Sub selectControl(ByRef t As Control)
On Error Resume Next
With t
.SelStart = 0
.SelLength = Len(.text)
.SetFocus
Dim p
Err.Clear
Set p = t.Parent
If Err.number <> 0 Then Set p = Nothing
Do While Not p Is Nothing
Err.Clear
If typename(p) = "Page" Then
p.Parent.value = p.index
End If
Err.Clear
Set p = p.Parent
If Err.number <> 0 Then Set p = Nothing
Loop
End With
On Error GoTo 0
End Sub