企业官网建设流程全解析

厦门海沧建设局网站,兴山县铁路建设协调指挥部网站,杭州富阳建设局网站首页,html在线运行hi#xff0c;大家好#xff01;为什么还不春节#xff0c;最近又不知道在忙些啥#xff0c;又半个月过去了#xff0c;答应大家的框架#xff0c;又又又跳票了#xff01;既然这样的话#xff0c;今天那就再给大家分享点干货#xff01;今天的代码量比较大#xff0…hi大家好为什么还不春节最近又不知道在忙些啥又半个月过去了答应大家的框架又又又跳票了既然这样的话今天那就再给大家分享点干货今天的代码量比较大大家给个一键三连吧谢谢大家啦啦啦平时我们在开发的过程中遇到需要验证的文本框是不是还在用IF ……Then MsgBox…… 这样的方式输出那也太Low了那今天就给大家分享一个完整的验证方案来吧让我们Hi起来现代 Web 开发如 Bootstrap、Vue 等框架通过 DOM 操作实现了“所见即所得”的验证反馈红框、图标、气泡提示。本文旨在通过 VBA 模拟这一机制。1。创建类模块首先我们先创建一个类模块ClsFieldValidator你没有看错我们上来就要创建一个类模块这里写了几个常用的验证必填、邮箱、手机号、身份证号、纯数字、长度限制、数值范围、自定义正则、日期格式。 类模块: ClsFieldValidator Option Compare Database Option Explicit 验证结果枚举 Public Enum ValidationResult vrValid 0 vrInvalid 1 vrEmpty 2 End Enum 验证类型枚举 Public Enum validationType vtRequired 1 必填 vtEmail 2 邮箱 vtMobile 3 手机号 vtIDCard 4 身份证号 vtNumeric 5 纯数字 vtLength 6 长度限制 vtRange 7 数值范围 vtCustomRegex 8 自定义正则 vtDate 9 日期格式 End Enum Private m_MinLength As Long Private m_MaxLength As Long Private m_MinValue As Double Private m_MaxValue As Double Private m_CustomPattern As String Private m_ErrorMessage As String 属性 Public Property Get errorMessage() As String errorMessage m_ErrorMessage End Property Public Property Let MinLength(value As Long) m_MinLength value End Property Public Property Let MaxLength(value As Long) m_MaxLength value End Property Public Property Let MinValue(value As Double) m_MinValue value End Property Public Property Let MaxValue(value As Double) m_MaxValue value End Property Public Property Let CustomPattern(value As String) m_CustomPattern value End Property 核心验证方法 Public Function Validate(ByVal inputValue As Variant, ByVal validationType As validationType) As ValidationResult Dim strValue As String strValue Nz(inputValue, ) 清空上次错误信息 m_ErrorMessage Select Case validationType Case vtRequired Validate ValidateRequired(strValue) Case vtEmail Validate ValidateEmail(strValue) Case vtMobile Validate ValidateMobile(strValue) Case vtIDCard Validate ValidateIDCard(strValue) Case vtNumeric Validate ValidateNumeric(strValue) Case vtLength Validate ValidateLength(strValue) Case vtRange Validate ValidateRange(strValue) Case vtCustomRegex Validate ValidateRegex(strValue) Case vtDate Validate ValidateDate(strValue) Case Else Validate vrValid End Select End Function 具体验证规则 必填验证 Private Function ValidateRequired(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then m_ErrorMessage 此字段为必填项 ValidateRequired vrEmpty Else ValidateRequired vrValid End If End Function 邮箱验证 Private Function ValidateEmail(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateEmail vrEmpty Exit Function End If 使用 VBScript.RegExp 进行正则验证 Dim regex As Object Set regex CreateObject(VBScript.RegExp) With regex .Global True .IgnoreCase True .Pattern ^[a-zA-Z0-9._%-][a-zA-Z0-9.-]\.[a-zA-Z]{2,}$ End With If regex.test(strValue) Then ValidateEmail vrValid Else m_ErrorMessage 请输入有效的邮箱地址 ValidateEmail vrInvalid End If Set regex Nothing End Function 手机号验证 (中国大陆11位手机号) Private Function ValidateMobile(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateMobile vrEmpty Exit Function End If Dim regex As Object Set regex CreateObject(VBScript.RegExp) With regex .Global True .Pattern ^1[3-9]\d{9}$ End With If regex.test(strValue) Then ValidateMobile vrValid Else m_ErrorMessage 请输入有效的11位手机号 ValidateMobile vrInvalid End If Set regex Nothing End Function 身份证号验证 (18位) Private Function ValidateIDCard(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateIDCard vrEmpty Exit Function End If Dim regex As Object Set regex CreateObject(VBScript.RegExp) With regex .Global True .IgnoreCase True 18位身份证6位地区码 8位生日 3位顺序码 1位校验码 .Pattern ^\d{6}(19|20)\d{2}(0[1-9]|1[0-2])(0[1-9]|[12]\d|3[01])\d{3}[\dXx]$ End With If regex.test(strValue) Then 进一步验证校验码 If ValidateIDCardChecksum(strValue) Then ValidateIDCard vrValid Else m_ErrorMessage 身份证号校验码错误 ValidateIDCard vrInvalid End If Else m_ErrorMessage 请输入有效的18位身份证号 ValidateIDCard vrInvalid End If Set regex Nothing End Function 身份证校验码算法 Private Function ValidateIDCardChecksum(strValue As String) As Boolean Dim weights As Variant Dim checkCodes As String Dim total As Long Dim i As Long weights Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) checkCodes 10X98765432 total 0 For i 1 To 17 total total CInt(Mid(strValue, i, 1)) * weights(i - 1) Next i Dim checkChar As String checkChar Mid(checkCodes, (total Mod 11) 1, 1) ValidateIDCardChecksum (UCase(Mid(strValue, 18, 1)) checkChar) End Function 纯数字验证 Private Function ValidateNumeric(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateNumeric vrEmpty Exit Function End If If IsNumeric(strValue) Then ValidateNumeric vrValid Else m_ErrorMessage 请输入有效的数字 ValidateNumeric vrInvalid End If End Function 长度验证 Private Function ValidateLength(strValue As String) As ValidationResult Dim strLen As Long strLen Len(strValue) If strLen 0 Then ValidateLength vrEmpty Exit Function End If If m_MinLength 0 And strLen m_MinLength Then m_ErrorMessage 长度不能少于 m_MinLength 个字符 ValidateLength vrInvalid ElseIf m_MaxLength 0 And strLen m_MaxLength Then m_ErrorMessage 长度不能超过 m_MaxLength 个字符 ValidateLength vrInvalid Else ValidateLength vrValid End If End Function 数值范围验证 Private Function ValidateRange(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateRange vrEmpty Exit Function End If If Not IsNumeric(strValue) Then m_ErrorMessage 请输入有效的数字 ValidateRange vrInvalid Exit Function End If Dim numValue As Double numValue CDbl(strValue) If numValue m_MinValue Then m_ErrorMessage 数值不能小于 m_MinValue ValidateRange vrInvalid ElseIf numValue m_MaxValue Then m_ErrorMessage 数值不能大于 m_MaxValue ValidateRange vrInvalid Else ValidateRange vrValid End If End Function 自定义正则验证 Private Function ValidateRegex(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateRegex vrEmpty Exit Function End If If Len(m_CustomPattern) 0 Then ValidateRegex vrValid Exit Function End If Dim regex As Object Set regex CreateObject(VBScript.RegExp) With regex .Global True .IgnoreCase True .Pattern m_CustomPattern End With If regex.test(strValue) Then ValidateRegex vrValid Else m_ErrorMessage 输入格式不正确 ValidateRegex vrInvalid End If Set regex Nothing End Function 日期格式验证 Private Function ValidateDate(strValue As String) As ValidationResult If Len(Trim(strValue)) 0 Then ValidateDate vrEmpty Exit Function End If If IsDate(strValue) Then ValidateDate vrValid Else m_ErrorMessage 请输入有效的日期 ValidateDate vrInvalid End If End Function2。添加一个通用模块接着我们要再创建一个通用模块。模块名M_ValidationUI 标准模块: M_ValidationUI Option Compare Database Option Explicit 验证状态图标 (使用 Unicode 字符) Public Const ICON_VALID As String 验证正确 Public Const ICON_INVALID As String 验证错误 Public Const ICON_EMPTY As String 颜色常量 Public Const COLOR_VALID As Long 32768 绿色 RGB(0, 128, 0) Public Const COLOR_INVALID As Long 255 红色 RGB(255, 0, 0) Public Const COLOR_WARNING As Long 33023 橙色 RGB(255, 128, 0) Public Const COLOR_DEFAULT As Long 0 黑色 更新验证状态显示 Public Sub UpdateValidationStatus( _ ByVal lblStatus As Access.Label, _ ByVal result As ValidationResult, _ Optional ByVal errorMessage As String ) Select Case result Case vrValid With lblStatus .Caption ICON_VALID .ForeColor COLOR_VALID .ControlTipText 验证通过 End With Case vrInvalid With lblStatus .Caption ICON_INVALID .ForeColor COLOR_INVALID .ControlTipText IIf(Len(errorMessage) 0, errorMessage, 验证失败) End With Case vrEmpty With lblStatus .Caption ICON_EMPTY .ForeColor COLOR_DEFAULT .ControlTipText End With End Select End Sub 高亮文本框边框 (模拟 Web 效果) Public Sub HighlightTextBox( _ ByVal txtControl As Access.TextBox, _ ByVal result As ValidationResult) Select Case result Case vrValid txtControl.BorderColor COLOR_VALID Case vrInvalid txtControl.BorderColor COLOR_INVALID Case vrEmpty txtControl.BorderColor COLOR_DEFAULT End Select End Sub 显示错误提示气泡 (使用标签模拟 Tooltip) Public Sub ShowErrorTooltip( _ ByVal lblTooltip As Access.Label, _ ByVal message As String, _ ByVal show As Boolean) If show And Len(message) 0 Then With lblTooltip .Caption message .Visible True .BackColor RGB(255, 240, 240) 浅红色背景 .ForeColor COLOR_INVALID .BorderColor COLOR_INVALID .BorderStyle 1 实线边框 End With Else lblTooltip.Visible False End If End Sub 验证整个表单返回是否全部通过 Public Function ValidateForm(frm As Access.Form, ParamArray validations() As Variant) As Boolean Dim i As Long Dim allValid As Boolean Dim result As ValidationResult Dim validator As ClsFieldValidator allValid True Set validator New ClsFieldValidator validations 参数格式: txtControl, lblStatus, ValidationType, [可选参数...] 示例调用: ValidateForm(Me, Me.txtEmail, Me.lblEmailStatus, vtEmail, ...) For i LBound(validations) To UBound(validations) Step 3 Dim txtCtrl As Access.TextBox Dim lblCtrl As Access.Label Dim vType As validationType Set txtCtrl validations(i) Set lblCtrl validations(i 1) vType validations(i 2) result validator.Validate(txtCtrl.value, vType) UpdateValidationStatus lblCtrl, result, validator.errorMessage HighlightTextBox txtCtrl, result If result vrInvalid Then allValid False 必填字段为空也算失败 If vType vtRequired And result vrEmpty Then allValid False Next i ValidateForm allValid Set validator Nothing End Function3。创建窗体类与通用的模块都有了接下来就教大家来调用了创建一个窗体具体的如下图一个文本框txtEmail2个标签lblEmailStatuslblMobileError一个按钮。这里我们只用一个邮件验证来举例4。窗体代码控件有了就可以来添加相应的调用代码了具体的代码里注释都添加好了大家自己查看添加。Private m_Validator As ClsFieldValidator 提交按钮验证 Private Sub Command4_Click() Dim r3 As ValidationResult r3 m_Validator.Validate(Me.txtEmail, vtEmail) UpdateValidationStatus Me.lblEmailStatus, r3, m_Validator.errorMessage HighlightTextBox Me.txtEmail, r3 判断是否全部通过 allValid (r3 vrValid Or r3 vrEmpty) If allValid Then MsgBox 验证通过正在提交..., vbInformation, 成功 Else MsgBox 请检查输入内容修正标红的字段。, vbExclamation, 验证失败 End If End Sub Private Sub Form_Load() Set m_Validator New ClsFieldValidator InitStatusLabels End Sub 初始化状态标签 Private Sub InitStatusLabels() Dim lbls As Variant Dim i As Long lbls Array(Me.lblEmailStatus) For i LBound(lbls) To UBound(lbls) With lbls(i) .Caption .FontSize 14 .FontBold True .TextAlign 2 居中 End With Next i 隐藏错误提示标签 Me.lblMobileError.Visible False End Sub 通用验证方法 Private Function ValidateField( _ txtCtrl As Access.TextBox, _ lblStatus As Access.Label, _ vType As validationType) As ValidationResult Dim result As ValidationResult result m_Validator.Validate(txtCtrl.value, vType) 更新 UI UpdateValidationStatus lblStatus, result, m_Validator.errorMessage HighlightTextBox txtCtrl, result ValidateField result End Function 可选失去焦点时验证 Private Sub txtEmail_LostFocus() Dim result As ValidationResult If Len(Nz(Me.txtEmail, )) 0 Then result ValidateField(Me.txtEmail, Me.lblEmailStatus, vtEmail) ShowErrorTooltip Me.lblMobileError, m_Validator.errorMessage, (result vrInvalid) End If End Sub5。运行测试最后就是运行测试了我们来看一下效果。这里的样式觉得不满意的也可以自行调整。设计思路采用 面向对象OOP 的设计思路将验证规则与 UI 渲染分离。ClsFieldValidator (类模块)核心逻辑层。负责封装正则表达式、处理数值比较、日期校验不包含任何 UI 代码。M_ValidationUI (标准模块)UI 渲染层。负责操作 Access 控件的边框颜色、标签内容。Form_xxx (窗体)调用层。在控件事件中实例化验证类并接收返回结果。喜欢这篇文章点个“在看”分享给更多 Access 开发者