Return to Answer

Below is an example refactoring that creates two of the classes needed: DecimalDigitTextBox and EmailTextBox. A standard module AdvTextBoxFactory is introduced to hold the common enums and constants. As the name implies, the module also acts as a Factory to create the specific of textbox validator class that is needed. And, most importantly, an IAdvTextBox interface is defined so that each textbox class can look the same for client code. Code the interacts with the TextBox directly has been moved to a TextBoxHandler class. Hope you find this useful.

Public Function HandleNewTextValue(ByVal value As Variant, ByRef outSelectText As Boolean) As Variant
End Function
Public Function HandleKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, value As String) As String
End Function
Public Sub ConnectToTextBox(txtBox As MSForms.TextBox)
End Sub
Public Sub ConfigureTypeSpecifics(value As TextBoxTypes)
End Sub
Public Function Validate() As Boolean
End Function
Public Property Get TextBoxType() As TextBoxTypes
End Property
Public Property Get MaxValue() As Double
End Property
Public Property Let MaxValue(ByVal value As Double)
End Property
Public Property Get MinValue() As Double
End Property
Public Property Let MinValue(ByVal value As Double)
End Property
Public Property Get FixedFormat() As Boolean
End Property
Public Property Let FixedFormat(ByVal value As Boolean)
End Property
Public Property Get ToCase() As DesiredCase
End Property
Public Property Let ToCase(ByVal value As DesiredCase)
End Property
Public Property Get InvalidValueMessage() As String
End Property
Public Property Let InvalidValueMessage(ByVal value As String)
End Property
Public Property Get IsValid() As Boolean
End Property
Public Property Let IsValid(ByVal value As Boolean)
End Property
Public Property Get ShowValidityThrough() As ValidityProperty
End Property
Public Property Let ShowValidityThrough(ByVal value As ValidityProperty)
End Property
Public Property Get ValidColor() As Long
End Property
Public Property Let ValidColor(ByVal value As Long)
End Property
Public Property Get InvalidColor() As Long
End Property
Public Property Let InvalidColor(ByVal value As Long)
End Property
Public Property Get Enlarged() As Boolean
End Property
Public Property Let Enlarged(ByVal value As Boolean)
End Property
Public Property Get AllowedCharacters() As String
End Property
Public Property Let AllowedCharacters(ByVal value As String)
End Property

Option Explicit
Public Type TTextBox
 TextBoxType As TextBoxTypes
 MaxValue As Double
 MinValue As Double
 FixedFormat As Boolean
 ToCase As DesiredCase
 InvalidValueMessage As String
 IsValid As Boolean
 ShowValidityThrough As ValidityProperty
 ValidColor As Long
 InvalidColor As Long
 AllowedCharacters As String
 OutputFormat As String
 DecimalSeparator As String
 Enlarged As Boolean
End Type
Public Enum TextBoxTypes
 ShortText = 0
 Notes = 1
 Iban = 10
 ItalianVatNumber = 11
 Email = 12
 WholeNumber = 20
 Decimal1Digit = 21
 Decimal2Digit = 22
 Decimal3Digit = 23
 Decimal4Digit = 24
 Decimal5Digit = 25
 Decimal6Digit = 26
End Enum
Public Enum DesiredCase
 Normal = 0
 UpperCase = 1
 LowerCase = 2
 ProperCase = 3
End Enum
Public Enum ValidityProperty
 NoOne = 0
 vBorders = 1
 vBackColor = 2
 vForeColor = 3
End Enum
' constants
Public Const numbers As String = "0123456789"
Public Const letters As String = "abcdefghijklmnopqrstuvwxyz"
Public Const accented As String = "èéàòì"
Public Const numberPunctuation As String = ",."
Public Const otherPunctuation As String = " !?=_/|-@€+"
Public Const defaultInvalidColor As Long = &H5F5BDD
Public Function Create(ByVal obj As MSForms.TextBox, _
 ByVal txtType As TextBoxTypes) As IAdvTextBox
 
 Dim advTxtBox As IAdvTextBox
 
 Select Case txtType
 Case ShortText
 'TODO
 Case Notes
 'TODO
 Case Iban
 'TODO
 Case ItalianVatNumber
 'TODO
 Case Email
 Set advTxtBox = New EmailTextBox
 Case WholeNumber
 'TODO
 Case Decimal1Digit, Decimal2Digit, Decimal3Digit, Decimal4Digit, Decimal5Digit, Decimal6Digit
 Set advTxtBox = New DecimalDigitTextBox
 Case Else
 'throw an error
 End Select
 
 advTxtBox.ConfigureTypeSpecifics txtType
 advTxtBox.ConnectToTextBox obj
 
 Select Case advTxtBox.ShowValidityThrough
 Case NoOne, vBackColor
 advTxtBox.ValidColor = obj.BackColor
 Case vBorders
 advTxtBox.ValidColor = obj.BorderColor
 Case vForeColor
 advTxtBox.ValidColor = obj.ForeColor
 End Select
 advTxtBox.InvalidColor = defaultInvalidColor
 Set Create = advTxtBox
End Function

Option Explicit
Implements IAdvTextBox
Private this As TTextBox
Private txtBoxHandler As TextBoxHandler
Private Sub Class_Initialize()
 Set txtBoxHandler = New TextBoxHandler
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 this.TextBoxType = Decimal1Digit 'factory sets correct value using IAdvTextBox_ConfigureTypeSpecifics
End Sub
Private Function IAdvTextBox_HandleNewTextValue(ByVal value As Variant, ByRef outSelectText As Boolean) As Variant
 outSelectText = False
 Dim valore As Variant
 valore = value
 valore = Replace(Replace(valore, ",", vbNullString), ".", vbNullString)
 If valore = vbNullString Then valore = 0
 valore = CDbl(valore)
 Select Case this.TextBoxType
 Case Decimal1Digit
 valore = valore / 10
 Case Decimal2Digit
 valore = valore / 100
 Case Decimal3Digit
 valore = valore / 1000
 Case Decimal4Digit
 valore = valore / 10000
 Case Decimal5Digit
 valore = valore / 100000
 Case Decimal6Digit
 valore = valore / 1000000
 End Select
 IAdvTextBox_HandleNewTextValue = valore
End Function
Private Function IAdvTextBox_HandleKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, value As String) As String
 IAdvTextBox_HandleKeyPress = value
 If KeyAscii = 45 Then
 IAdvTextBox_HandleKeyPress = CDbl(value) * -1
 End If
End Function

Private Sub IAdvTextBox_ConnectToTextBox(txtBox As MSForms.TextBox)
 txtBoxHandler.ConnectToTextBox txtBox, Me
End Sub
Private Sub IAdvTextBox_ConfigureTypeSpecifics(value As TextBoxTypes)
 this.TextBoxType = value
 Select Case value
 Case Decimal1Digit
 this.OutputFormat = "#,##0.0"
 Case Decimal2Digit
 this.OutputFormat = "#,##0.00"
 Case Decimal3Digit
 this.OutputFormat = "#,##0.000"
 Case Decimal4Digit
 this.OutputFormat = "#,##0.0000"
 Case Decimal5Digit
 this.OutputFormat = "#,##0.00000"
  Case Decimal6Digit
  this.OutputFormat = "#,##0.000000"
  Case Else
 'throw an error
 End Select
 
 this.AllowedCharacters = numbers & IIf(this.FixedFormat, vbNullString, numberPunctuation)
 txtBoxHandler.TextBox.ControlTipText = "Press ""-"" to change the sign"
 txtBoxHandler.TextBox.text = 0
End Sub
Private Function IAdvTextBox_Validate() As Boolean
 txtBoxHandler.ColorTextBox this.IsValid, Me
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
Private Property Get IAdvTextBox_TextBoxType() As TextBoxTypes
 IAdvTextBox_TextBoxType = this.TextBoxType
End Property
Private Property Get IAdvTextBox_MaxValue() As Double
 IAdvTextBox_MaxValue = this.MaxValue
End Property
Private Property Let IAdvTextBox_MaxValue(ByVal value As Double)
 this.MaxValue = value
End Property
Private Property Get IAdvTextBox_MinValue() As Double
 IAdvTextBox_MinValue = this.MinValue
End Property
Private Property Let IAdvTextBox_MinValue(ByVal value As Double)
 this.MinValue = value
End Property
Private Property Get IAdvTextBox_FixedFormat() As Boolean
 IAdvTextBox_FixedFormat = this.FixedFormat
End Property
Private Property Let IAdvTextBox_FixedFormat(ByVal value As Boolean)
 this.FixedFormat = value
End Property
Private Property Get IAdvTextBox_ToCase() As DesiredCase
 IAdvTextBox_ToCase = this.ToCase
End Property
Private Property Let IAdvTextBox_ToCase(ByVal value As DesiredCase)
 this.ToCase = value
End Property
Private Property Get IAdvTextBox_InvalidValueMessage() As String
 IAdvTextBox_InvalidValueMessage = this.InvalidValueMessage
End Property
Private Property Let IAdvTextBox_InvalidValueMessage(ByVal value As String)
 this.InvalidValueMessage = value
End Property
Private Property Get IAdvTextBox_IsValid() As Boolean
 IAdvTextBox_IsValid = this.IsValid
End Property
Private Property Let IAdvTextBox_IsValid(ByVal value As Boolean)
 this.IsValid = value
 txtBoxHandler.ColorTextBox this.IsValid, Me
End Property
Private Property Get IAdvTextBox_ShowValidityThrough() As ValidityProperty
 IAdvTextBox_ShowValidityThrough = this.ShowValidityThrough
End Property
Private Property Let IAdvTextBox_ShowValidityThrough(ByVal value As ValidityProperty)
 this.ShowValidityThrough = value
 txtBoxHandler.ColorTextBox IAdvTextBox_IsValid, Me
End Property
Private Property Get IAdvTextBox_ValidColor() As Long
 IAdvTextBox_ValidColor = this.ValidColor
End Property
Private Property Let IAdvTextBox_ValidColor(ByVal value As Long)
 this.ValidColor = value
 txtBoxHandler.ColorTextBox IAdvTextBox_IsValid, Me
End Property
Private Property Get IAdvTextBox_InvalidColor() As Long
 IAdvTextBox_InvalidColor = this.InvalidColor
End Property
Private Property Let IAdvTextBox_InvalidColor(ByVal value As Long)
 this.InvalidColor = value
End Property
Private Property Get IAdvTextBox_Enlarged() As Boolean
 IAdvTextBox_Enlarged = this.Enlarged
End Property
Private Property Let IAdvTextBox_Enlarged(ByVal value As Boolean)
 this.Enlarged = value
 txtBoxHandler.ColorTextBox IAdvTextBox_IsValid, Me
End Property
Private Property Get IAdvTextBox_AllowedCharacters() As String
 IAdvTextBox_AllowedCharacters = this.AllowedCharacters
End Property
Private Property Let IAdvTextBox_AllowedCharacters(ByVal value As String)
 this.AllowedCharacters = value
End Property

Option Explicit
Implements IAdvTextBox
Private txtBoxHandler As TextBoxHandler
Private this As TTextBox
Private Sub Class_Initialize()
 Set txtBoxHandler = New TextBoxHandler
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 this.TextBoxType = Email
End Sub
Private Function IsValidEmail(ByVal emailAddress As String) As Boolean
 
 IsValidEmail = False
 
 Const emailPattern As String = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
 
 With CreateObject("VBScript.RegExp")
 .Global = True
 .IgnoreCase = True
 .Pattern = emailPattern
 IsValidEmail = .Test(emailAddress)
 End With
 
End Function
Private Function IAdvTextBox_HandleNewTextValue(ByVal value As Variant, ByRef outSelectText As Boolean) As Variant
 outSelectText = False
 Dim valore As Variant
 valore = value
 
 IAdvTextBox_IsValid = IsValidEmail(valore)
 valore = LCase(valore)
 
 IAdvTextBox_HandleNewTextValue = valore
End Function
Private Function IAdvTextBox_HandleKeyPress(ByVal KeyAscii As MSForms.ReturnInteger, value As String) As String
 'nothing to do
End Function
Private Sub IAdvTextBox_ConnectToTextBox(txtBox As MSForms.TextBox)
 txtBoxHandler.ConnectToTextBox txtBox, Me
End Sub

Private Sub IAdvTextBox_ConfigureTypeSpecifics(value As TextBoxTypes)
 this.AllowedCharacters = numbers & letters & numberPunctuation & otherPunctuation
 txtBoxHandler.TextBox.text = ""
End Sub
Private Function IAdvTextBox_Validate() As Boolean
 txtBoxHandler.ColorTextBox this.IsValid, Me
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
'Other properties are the same as for DecimalDigitTextBox and are omitted here

TextBoxHandler

Option Explicit

Private WithEvents txt As MSForms.TextBox
Private theClient As IAdvTextBox
Private pAllowEvents As Boolean

Private Sub Class_Initialize()
 pAllowEvents = True
End Sub

Public Sub ConnectToTextBox(txtBox As MSForms.TextBox, client As IAdvTextBox)
 Set txt = txtBox
 Set theClient = client
End Sub
Public Property Get TextBox() As MSForms.TextBox
 Set TextBox = txt
End Property
Public Sub ColorTextBox(validity As Boolean, tb As IAdvTextBox)
 If (Not tb.ShowValidityThrough = NoOne) And (Not txt Is Nothing) Then
 Select Case tb.ShowValidityThrough
 Case vBackColor
 txt.BackColor = IIf(validity, tb.ValidColor, tb.InvalidColor)
 Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
 txt.BorderColor = IIf(validity, tb.ValidColor, tb.InvalidColor)
 txt.Width = txt.Width + IIf(tb.Enlarged, -0.1, 0.1)
 tb.Enlarged = Not tb.Enlarged
 Case vForeColor
 txt.ForeColor = IIf(validity, tb.ValidColor, tb.InvalidColor)
 End Select
 End If
End Sub
Private Sub txt_Change()
 
 If Not pAllowEvents Then Exit Sub
 
 pAllowEvents = False
 
 Dim byRefSelectText As Boolean
 
 txt.text = theClient.HandleNewTextValue(txt.text, byRefSelectText)
 
 If byRefSelectText Then
 txt.SelStart = 0
 txt.SelLength = Len(CStr(txt.text))
 End If
 
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

 txt.text = theClient.HandleKeyPress(KeyAscii, txt.text)
End Sub

Below is an example refactoring that creates two of the classes needed: DecimalDigitTextBox and EmailTextBox. A standard module AdvTextBoxFactory is introduced to hold the common enums and constants. As the name implies, the module also acts as a Factory to create the specific of textbox validator class that is needed. And, most importantly, an IAdvTextBox interface is defined so that each textbox class can look the same for client code. Hope you find this useful.

Public Function Validate() As Boolean
End Function
Public Property Get TextBoxType() As TextBoxTypes
End Property
Public Property Get MaxValue() As Double
End Property
Public Property Let MaxValue(ByVal value As Double)
End Property
Public Property Get MinValue() As Double
End Property
Public Property Let MinValue(ByVal value As Double)
End Property
Public Property Get FixedFormat() As Boolean
End Property
Public Property Let FixedFormat(ByVal value As Boolean)
End Property
Public Property Get ToCase() As DesiredCase
End Property
Public Property Let ToCase(ByVal value As DesiredCase)
End Property
Public Property Get InvalidValueMessage() As String
End Property
Public Property Let InvalidValueMessage(ByVal value As String)
End Property
Public Property Get IsValid() As Boolean
End Property
Public Property Let IsValid(ByVal value As Boolean)
End Property
Public Property Get ShowValidityThrough() As ValidityProperty
End Property
Public Property Let ShowValidityThrough(ByVal value As ValidityProperty)
End Property
Public Property Get ValidColor() As Long
End Property
Public Property Let ValidColor(ByVal value As Long)
End Property
Public Property Get InvalidColor() As Long
End Property
Public Property Let InvalidColor(ByVal value As Long)
End Property
Public Property Get Enlarged() As Boolean
End Property
Public Property Let Enlarged(ByVal value As Boolean)
End Property
Public Property Get AllowedCharacters() As String
End Property
Public Property Let AllowedCharacters(ByVal value As String)
End Property

Option Explicit
Public Type TAdvTextBox
 TextBoxType As TextBoxTypes
 MaxValue As Double
 MinValue As Double
 FixedFormat As Boolean
 ToCase As DesiredCase
 InvalidValueMessage As String
 IsValid As Boolean
 ShowValidityThrough As ValidityProperty
 ValidColor As Long
 InvalidColor As Long
 AllowedCharacters As String
 outputFormat As String
 DecimalSeparator As String
 Enlarged As Boolean
End Type
Public Enum TextBoxTypes
 ShortText = 0
 Notes = 1
 Iban = 10
 ItalianVatNumber = 11
 Email = 12
 WholeNumber = 20
 Decimal1Digit = 21
 Decimal2Digit = 22
 Decimal3Digit = 23
 Decimal4Digit = 24
 Decimal5Digit = 25
 Decimal6Digit = 26
End Enum
Public Enum DesiredCase
 Normal = 0
 UpperCase = 1
 LowerCase = 2
 ProperCase = 3
End Enum
Public Enum ValidityProperty
 NoOne = 0
 vBorders = 1
 vBackColor = 2
 vForeColor = 3
End Enum
' constants
Public Const numbers As String = "0123456789"
Public Const letters As String = "abcdefghijklmnopqrstuvwxyz"
Public Const accented As String = "èéàòì"
Public Const numberPunctuation As String = ",."
Public Const otherPunctuation As String = " !?=_/|-@€+"
Public Const defaultInvalidColor As Long = &H5F5BDD
Public Function Create(ByVal obj As MSForms.TextBox, _
 ByVal txtType As TextBoxTypes) As IAdvTextBox
 
 Dim advTxtBox As IAdvTextBox
 
 Select Case txtType
 Case ShortText
 'TODO
 Case Notes
 'TODO
 Case Iban
 'TODO
 Case ItalianVatNumber
 'TODO
 Case Email
 Dim emTxtBox As EmailTextBox
 Set emTxtBox = New EmailTextBox
 emTxtBox.ConnectToTextBox obj
  Set advTxtBox = emTxtBox
 Case WholeNumber
 'TODO
 Case Decimal1Digit, Decimal2Digit, Decimal3Digit, Decimal4Digit, Decimal5Digit, Decimal6Digit
 Dim ddTextBox As DecimalDigitTextBox
  Set ddTextBox = New DecimalDigitTextBox
 ddTextBox.SetupDecimalDigits txtType
  ddTextBox.ConnectToTextBox obj
  Set advTxtBox = ddTextBox
 Case Else
  'throw an error
 End Select
 
 Select Case advTxtBox.ShowValidityThrough
 Case NoOne, vBackColor
 advTxtBox.ValidColor = obj.BackColor
 Case vBorders
 advTxtBox.ValidColor = obj.BorderColor
 Case vForeColor
 advTxtBox.ValidColor = obj.ForeColor
 End Select
 advTxtBox.InvalidColor = defaultInvalidColor
 Set Create = advTxtBox
End Function

Option Explicit
Private WithEvents txt As MSForms.TextBox
Implements IAdvTextBox
Private this As TAdvTextBox
Private pDecimalDigitsDivisor As Long
Private pAllowEvents As Boolean
Private Sub Class_Initialize()
 pAllowEvents = True
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 
 'factory updates with correct values in SetupDecimalDigits
 this.TextBoxType = Decimal1Digit this.outputFormat = "#,##0.0"
 pDecimalDigitsDivisor = 10
End Sub
Public Sub ConnectToTextBox(txtBox As MSForms.TextBox)
 Set txt = txtBox
 this.AllowedCharacters = numbers & IIf(this.FixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 txt.text = 0
End Sub
Public Sub SetupDecimalDigits(ByVal txtType As TextBoxTypes)
 this.TextBoxType = txtType
 Select Case txtType
 Case Decimal1Digit
 this.outputFormat = "#,##0.0"
  pDecimalDigitsDivisor = 10
 Case Decimal2Digit
 this.outputFormat = "#,##0.00"
  pDecimalDigitsDivisor = 100
 Case Decimal3Digit
 this.outputFormat = "#,##0.000"
  pDecimalDigitsDivisor = 1000
 Case Decimal4Digit
 this.outputFormat = "#,##0.0000"
  pDecimalDigitsDivisor = 10000
 Case Decimal5Digit
 this.outputFormat = "#,##0.00000"
  pDecimalDigitsDivisor = 100000
 Case Decimal6Digit
 this.outputFormat = "#,##0.000000"
 pDecimalDigitsDivisor = 1000000
 Case Else
 'throw an error
 End Select
End Sub
Private Sub txt_Change()
  
 If Not pAllowEvents Then Exit Sub
 
 pAllowEvents = False
  
 Dim valore As Variant
 valore = Replace(Replace(txt.text, ",", vbNullString), ".", vbNullString) 
 If valore = vbNullString Then valore = 0
 
 valore = CDbl(valore) / pDecimalDigitsDivisor
 
 txt.text = CStr(valore)
 
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If KeyAscii = 45 Then
 txt.text = CDbl(txt.text) * -1
 End If
 
 If Not KeyAscii = 8 Then
  If InStr(1, this.AllowedCharacters, Chr(KeyAscii), vbTextCompare) = 0 Then KeyAscii = 0
 End If
End Sub
Private Sub ColorTextBox(validity As Boolean)
 If (Not this.ShowValidityThrough = NoOne) And (Not txt Is Nothing) Then
 
 Dim color As Long
 color = IIf(validity, this.ValidColor, this.InvalidColor)
 
 Select Case this.ShowValidityThrough
  Case vBackColor
 txt.BackColor = color
  Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
  txt.BorderColor = color
 txt.Width = txt.Width + IIf(this.Enlarged, -0.1, 0.1)
  this.Enlarged = Not this.Enlarged
  Case vForeColor
  txt.ForeColor = color
 End Select
 End If
End Sub
Private Function IAdvTextBox_Validate() As Boolean
 ColorTextBox this.IsValid
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
Private Property Get IAdvTextBox_TextBoxType() As TextBoxTypes
 IAdvTextBox_TextBoxType = this.TextBoxType
End Property
Private Property Get IAdvTextBox_MaxValue() As Double
 IAdvTextBox_MaxValue = this.MaxValue
End Property
Private Property Let IAdvTextBox_MaxValue(ByVal value As Double)
 this.MaxValue = value
End Property
Private Property Get IAdvTextBox_MinValue() As Double
 IAdvTextBox_MinValue = this.MinValue
End Property
Private Property Let IAdvTextBox_MinValue(ByVal value As Double)
 this.MinValue = value
End Property
Private Property Get IAdvTextBox_FixedFormat() As Boolean
 IAdvTextBox_FixedFormat = this.FixedFormat
End Property
Private Property Let IAdvTextBox_FixedFormat(ByVal value As Boolean)
 this.FixedFormat = value
End Property
Private Property Get IAdvTextBox_ToCase() As DesiredCase
 IAdvTextBox_ToCase = this.ToCase
End Property
Private Property Let IAdvTextBox_ToCase(ByVal value As DesiredCase)
 this.ToCase = value
End Property
Private Property Get IAdvTextBox_InvalidValueMessage() As String
 IAdvTextBox_InvalidValueMessage = this.InvalidValueMessage
End Property
Private Property Let IAdvTextBox_InvalidValueMessage(ByVal value As String)
 this.InvalidValueMessage = value
End Property
Private Property Get IAdvTextBox_IsValid() As Boolean
 IAdvTextBox_IsValid = this.IsValid
End Property
Private Property Let IAdvTextBox_IsValid(ByVal value As Boolean)
 this.IsValid = value
 ColorTextBox this.IsValid
End Property
Private Property Get IAdvTextBox_ShowValidityThrough() As ValidityProperty
 IAdvTextBox_ShowValidityThrough = this.ShowValidityThrough
End Property
Private Property Let IAdvTextBox_ShowValidityThrough(ByVal value As ValidityProperty)
 this.ShowValidityThrough = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_ValidColor() As Long
 IAdvTextBox_ValidColor = this.ValidColor
End Property
Private Property Let IAdvTextBox_ValidColor(ByVal value As Long)
 this.ValidColor = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_InvalidColor() As Long
 IAdvTextBox_InvalidColor = this.InvalidColor
End Property
Private Property Let IAdvTextBox_InvalidColor(ByVal value As Long)
 this.InvalidColor = value
End Property
Private Property Get IAdvTextBox_Enlarged() As Boolean
 IAdvTextBox_Enlarged = this.Enlarged
End Property
Private Property Let IAdvTextBox_Enlarged(ByVal value As Boolean)
 this.Enlarged = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_AllowedCharacters() As String
 IAdvTextBox_AllowedCharacters = this.AllowedCharacters
End Property
Private Property Let IAdvTextBox_AllowedCharacters(ByVal value As String)
 this.AllowedCharacters = value
End Property

Option Explicit
Implements IAdvTextBox
Private WithEvents txt  As MSForms.TextBox
Private this As TAdvTextBox
Private pAllowEvents As Boolean
Private Sub Class_Initialize()
 pAllowEvents = True
 this.DecimalSeparator = Application.DecimalSeparator
 this.FixedFormat = True
 this.ShowValidityThrough = NoOne
 this.ToCase = Normal
 this.ValidColor = -1
 this.InvalidColor = -1
 this.TextBoxType = Email
End Sub
Private Function IsValidEmail(ByVal emailAddress As String) As Boolean
 
 IsValidEmail = False
 
 Const emailPattern As String = "^([a-zA-Z0-9_\-\.]+)@[a-z0-9-]+(\.[a-z0-9-]+)*(\.[a-z]{2,3})$"
 
 With CreateObject("VBScript.RegExp")
 .Global = True
 .IgnoreCase = True
 .Pattern = emailPattern
 IsValidEmail = .Test(emailAddress)
 End With
 
End Function
Public Sub ConnectToTextBox(txtBox As MSForms.TextBox)
 Set txt = txtBox
End Sub
Private Sub txt_Change() 
 If Not pAllowEvents Then Exit Sub
 
 pAllowEvents = False
 Dim valore As Variant
 valore = txt.text
 
 this.IsValid = IsValidEmail(valore)
 valore = LCase(valore)
 
 txt.text = valore
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If Not KeyAscii = 8 Then
 If InStr(1, this.AllowedCharacters, Chr(KeyAscii), vbTextCompare) = 0 Then KeyAscii = 0
 End If
End Sub
Private Sub ColorTextBox(validity As Boolean)
 If (Not this.ShowValidityThrough = NoOne) And (Not txt Is Nothing) Then  Dim color As Long
 color = IIf(validity, this.ValidColor, this.InvalidColor)
  Select Case this.ShowValidityThrough
 Case vBackColor
 txt.BackColor = color
  Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
  txt.BorderColor = color
 txt.Width = txt.Width + IIf(this.Enlarged, -0.1, 0.1) this.Enlarged = Not this.Enlarged
 Case vForeColor
 txt.ForeColor = color
 End Select
 End If
End Sub

Private Function IAdvTextBox_Validate() As Boolean
 ColorTextBox this.IsValid
 If (Not this.IsValid) And (Not this.InvalidValueMessage = vbNullString) Then MsgBox this.InvalidValueMessage, vbInformation, "Invalid value"
 IAdvTextBox_Validate = this.IsValid
End Function
Private Property Get IAdvTextBox_TextBoxType() As TextBoxTypes
 IAdvTextBox_TextBoxType = this.TextBoxType
End Property
Private Property Get IAdvTextBox_MaxValue() As Double
 IAdvTextBox_MaxValue = this.MaxValue
End Property
Private Property Let IAdvTextBox_MaxValue(ByVal value As Double)
 this.MaxValue = value
End Property
Private Property Get IAdvTextBox_MinValue() As Double
 IAdvTextBox_MinValue = this.MinValue
End Property
Private Property Let IAdvTextBox_MinValue(ByVal value As Double)
 this.MinValue = value
End Property

Private Property Get IAdvTextBox_FixedFormat() As Boolean
 IAdvTextBox_FixedFormat = this.FixedFormat
End Property
Private Property Let IAdvTextBox_FixedFormat(ByVal value As Boolean)
 this.FixedFormat = value
End Property
Private Property Get IAdvTextBox_ToCase() As DesiredCase
 IAdvTextBox_ToCase = this.ToCase
End Property
Private Property Let IAdvTextBox_ToCase(ByVal value As DesiredCase)
 this.ToCase = value
End Property
Private Property Get IAdvTextBox_InvalidValueMessage() As String
 IAdvTextBox_InvalidValueMessage = this.InvalidValueMessage
End Property
Private Property Let IAdvTextBox_InvalidValueMessage(ByVal value As String)
 this.InvalidValueMessage = value
End Property
Private Property Get IAdvTextBox_IsValid() As Boolean
  IAdvTextBox_IsValid = this.IsValid
End Property
Private Property Let IAdvTextBox_IsValid(ByVal value As Boolean)
 this.IsValid = value
 ColorTextBox this.IsValid
End Property
Private Property Get IAdvTextBox_ShowValidityThrough() As ValidityProperty
 IAdvTextBox_ShowValidityThrough = this.ShowValidityThrough
End Property

Private Property Let IAdvTextBox_ShowValidityThrough(ByVal value As ValidityProperty)
 this.ShowValidityThrough = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_ValidColor() As Long
 IAdvTextBox_ValidColor = this.ValidColor
End Property
Private Property Let IAdvTextBox_ValidColor(ByVal value As Long)
 this.ValidColor = value
 ColorTextBox IAdvTextBox_IsValid
End Property

Private Property Get IAdvTextBox_InvalidColor() As Long
 IAdvTextBox_InvalidColor = this.InvalidColor
End Property
Private Property Let IAdvTextBox_InvalidColor(ByVal value As Long)
  this.InvalidColor = value
End Property
Private Property Get IAdvTextBox_Enlarged() As Boolean
 IAdvTextBox_Enlarged = this.Enlarged
End Property

Private Property Let IAdvTextBox_Enlarged(ByVal value As Boolean)
 this.Enlarged = value
 ColorTextBox IAdvTextBox_IsValid
End Property
Private Property Get IAdvTextBox_AllowedCharacters() As String
 IAdvTextBox_AllowedCharacters = this.AllowedCharacters
End Property
Private Property Let IAdvTextBox_AllowedCharacters(ByVal value As String)
 this.AllowedCharacters = value
End Property