2
\$\begingroup\$

So, I created a class to avoid all the work behind the validation of input in a textbox.

The idea is to pass an existing textbox and a type of the desired content and the class will take care of block unacceptable input (for example letters in a numeric textbox), validate the text while the user writes and display a message if the content is invalid.

Exposed Methods

  • Create: associates the existing textbox to the class, set the content type, and set appearance properties
  • Validate: checks validity of content and display the message

Exposed properties

  • TextBoxType: Let|Get custom - content type
  • MaxValue: Let|Get double - only valid for numeric types
  • MinValue: Let|Get double - only valid for numeric types
  • FixedFormat: Let|Get boolean - only valid for numeric types, maintain the format of the number while typing
  • ToCase: Let|Get custom - only valid for non-numeric types, change the case of the string while typing
  • InvalidValueMessage: Let|Get string - message showed by the Validate function if the content is not vald
  • IsValid: Get boolean - content validity by the type expected
  • ShowValidityThrough: Let|Get custom - IsValid property can colour the textbox to indicate to the user if the content is valid or not. You can choose to colour backcolor, forecolor or bordercolor
  • ValidColor: Let|Get long - the color of the ShowValidityThrough property if the content is valid
  • InvalidColor: Let|Get long - the colour of the ShowValidityThrough property if the content is not valid

I would like to have some advice if you can on the design and on the possible errors you can see. Also advises on other possible types are very welcome! Thank you!

Class Name AdvTextBox

Option Explicit
Private WithEvents txt As MSForms.TextBox
' properties storage
Private pTextBoxType As TextBoxTypes
Private pMaxValue As Double
Private pMinValue As Double
Private pFixedFormat As Boolean
Private pToCase As DesiredCase
Private pInvalidValueMessage As String
Private pIsValid As Boolean
Private pShowValidityThrough As ValidityProperty
Private pValidColor As Long
Private pInvalidColor As Long
' calculated
Private pAllowedCharacters As String
Private pEvaluateMinMax As Boolean
Private pAllowEvents As Boolean
Private pOutputFormat As String
Private pEnlarged As Boolean
Private DecimalSeparator As String
' constants
Private Const numbers As String = "0123456789"
Private Const letters As String = "abcdefghijklmnopqrstuvwxyz"
Private Const accented As String = "èéàòì"
Private Const numberPunctuation As String = ",."
Private Const otherPunctuation As String = " !?=_/|-@€+"
Private Const defaultInvalidColor As Long = &H5F5BDD
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
' class
Private Sub Class_Initialize()
 DecimalSeparator = Application.DecimalSeparator
 pAllowEvents = True
 pFixedFormat = True
 pShowValidityThrough = NoOne
 pToCase = Normal
 pValidColor = -1
 pInvalidColor = -1
End Sub
' let properties
Public Property Let InvalidValueMessage(value As String)
 pInvalidValueMessage = value
End Property
Public Property Let ShowValidityThrough(value As ValidityProperty)
 pShowValidityThrough = value
 ColorTextBox pIsValid
End Property
Public Property Let ValidColor(value As Long)
 pValidColor = value
 ColorTextBox pIsValid
End Property
Public Property Let InvalidColor(value As Long)
 pInvalidColor = value
 ColorTextBox pIsValid
End Property
Public Property Let ToCase(value As DesiredCase)
 pToCase = value
End Property
Public Property Let FixedFormat(value As Boolean)
 pFixedFormat = value
 Select Case pTextBoxType
 Case WholeNumber
 pOutputFormat = "#,##0"
 pAllowedCharacters = numbers
 Case Decimal1Digit
 pOutputFormat = "#,##0.0"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 Case Decimal2Digit
 pOutputFormat = "#,##0.00"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 Case Decimal3Digit
 pOutputFormat = "#,##0.000"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 Case Decimal4Digit
 pOutputFormat = "#,##0.0000"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 Case Decimal5Digit
 pOutputFormat = "#,##0.00000"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 Case Decimal6Digit
 pOutputFormat = "#,##0.000000"
 pAllowedCharacters = numbers & IIf(value, vbNullString, numberPunctuation)
 End Select
End Property
Private Property Let IsValid(value As Boolean)
 pIsValid = value
 ColorTextBox value
End Property
Public Property Let MinValue(value As Double)
 pEvaluateMinMax = True
 pMinValue = value
End Property
Public Property Let MaxValue(value As Double)
 pEvaluateMinMax = True
 pMaxValue = value
End Property
Private Property Let TextBoxType(value As TextBoxTypes)
 
 Dim text As String
 Dim maxLength As Long
 
 pTextBoxType = value
 
 Select Case value
 Case ShortText
 maxLength = 40
 pAllowedCharacters = numbers & letters & numberPunctuation & otherPunctuation
 Case Notes
 txt.EnterKeyBehavior = True
 txt.MultiLine = True
 pAllowedCharacters = numbers & letters & numberPunctuation & otherPunctuation & accented & Chr(10) & Chr(13)
 Case Iban
 maxLength = 31
 pAllowedCharacters = numbers & letters
 Case ItalianVatNumber
 maxLength = 11
 pAllowedCharacters = numbers
 Case Email
 pAllowedCharacters = numbers & letters & numberPunctuation & otherPunctuation
 Case WholeNumber
 text = 0
 pOutputFormat = "#,##0"
 pAllowedCharacters = numbers
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal1Digit
 text = 0
 pOutputFormat = "#,##0.0"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal2Digit
 text = 0
 pOutputFormat = "#,##0.00"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal3Digit
 text = 0
 pOutputFormat = "#,##0.000"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal4Digit
 text = 0
 pOutputFormat = "#,##0.0000"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal5Digit
 text = 0
 pOutputFormat = "#,##0.00000"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 Case Decimal6Digit
 text = 0
 pOutputFormat = "#,##0.000000"
 pAllowedCharacters = numbers & IIf(pFixedFormat, vbNullString, numberPunctuation)
 txt.ControlTipText = "Press ""-"" to change the sign"
 End Select
 
 If maxLength > 0 Then txt.maxLength = maxLength
 txt.text = text
 
End Property
 
' get properties
Public Property Get InvalidValueMessage() As String
 InvalidValueMessage = pInvalidValueMessage
End Property
Public Property Get ShowValidityThrough() As ValidityProperty
 ShowValidityThrough = pShowValidityThrough
End Property
Public Property Get ToCase() As DesiredCase
 ToCase = pToCase
End Property
Public Property Get FixedFormat() As Boolean
 FixedFormat = pFixedFormat
End Property
 
Public Property Get MaxValue() As Double
 MaxValue = pMaxValue
End Property
Public Property Get MinValue() As Double
 MinValue = pMinValue
End Property
Public Property Get IsValid() As Boolean
 ColorTextBox pIsValid
 IsValid = pIsValid
End Property
Public Property Get ValidColor() As Long
 ValidColor = pValidColor
End Property
Public Property Get InvalidColor() As Long
 InvalidColor = pInvalidColor
End Property
Private Property Get TextBoxType() As TextBoxTypes
 TextBoxType = pTextBoxType
End Property
 
' exposed methods and functions
Public Function Create(ByVal obj As MSForms.TextBox, _
 ByVal txtType As TextBoxTypes) As AdvTextBox
 
 If pValidColor = -1 Then
 Select Case pShowValidityThrough
 Case NoOne, vBackColor
 pValidColor = obj.BackColor
 Case vBorders
 pValidColor = obj.BorderColor
 Case vForeColor
 pValidColor = obj.ForeColor
 End Select
 End If
 If pInvalidColor = -1 Then
 pInvalidColor = defaultInvalidColor
 End If
 
 Set txt = obj
 TextBoxType = txtType
 
 Set Create = Me
 
End Function
Public Function Validate() As Boolean
 
 ColorTextBox pIsValid
 If (Not pIsValid) And (Not pInvalidValueMessage = vbNullString) Then MsgBox pInvalidValueMessage, vbInformation, "Invalid value"
 Validate = pIsValid
 
End Function
' textbox events
Private Sub txt_Change()
 
 If Not pAllowEvents Then Exit Sub
 pAllowEvents = False
 
 Dim valore As Variant
 
 valore = txt.text
 
 Select Case pTextBoxType
 Case ShortText
 If Not pToCase = Normal Then valore = StrConv(valore, pToCase)
 Case Notes
 If Not pToCase = Normal Then valore = StrConv(valore, pToCase)
 Case Iban
 IsValid = isValidIBAN(valore)
 valore = UCase(valore)
 Case ItalianVatNumber
 IsValid = IsValidItalianVatNumber(valore)
 Case Email
 IsValid = IsValidEmail(valore)
 valore = LCase(valore)
 Case Else
 Dim selectText As Boolean
 If pFixedFormat Then
 valore = Replace(Replace(valore, ",", vbNullString), ".", vbNullString)
 If valore = vbNullString Then valore = 0
 valore = CDbl(valore)
 Select Case pTextBoxType
 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
 Else
 valore = Replace(valore, IIf(DecimalSeparator = ",", ".", ","), IIf(DecimalSeparator = ",", ",", "."))
 If Not IsNumeric(valore) Then
 valore = 0
 selectText = True
 End If
 End If
 If pEvaluateMinMax Then
 IsValid = (Not valore < pMinValue) And (Not valore > pMaxValue)
 End If
 If pFixedFormat Then valore = Format(valore, pOutputFormat)
 End Select
 
 txt.text = valore
 If selectText Then
 txt.SelStart = 0
 txt.SelLength = Len(CStr(valore))
 End If
 
 pAllowEvents = True
 
End Sub
Private Sub txt_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
 If KeyAscii = 45 Then
 Select Case pTextBoxType
 Case WholeNumber, Decimal1Digit, Decimal2Digit, Decimal3Digit, Decimal4Digit, Decimal5Digit, Decimal6Digit
 txt.text = CDbl(txt.text) * -1
 End Select
 End If
 If Not KeyAscii = 8 Then
 If InStr(1, pAllowedCharacters, Chr(KeyAscii), vbTextCompare) = 0 Then KeyAscii = 0
 End If
End Sub
' validation routines
Private Sub ColorTextBox(validity As Boolean)
 If (Not pShowValidityThrough = NoOne) And (Not txt Is Nothing) Then
 Select Case pShowValidityThrough
 Case vBackColor
 txt.BackColor = IIf(validity, pValidColor, pInvalidColor)
 Case vBorders
 txt.BorderStyle = fmBorderStyleSingle
 txt.BorderColor = IIf(validity, pValidColor, pInvalidColor)
 txt.Width = txt.Width + IIf(pEnlarged, -0.1, 0.1)
 pEnlarged = Not pEnlarged
 Case vForeColor
 txt.ForeColor = IIf(validity, pValidColor, pInvalidColor)
 End Select
 End If
End Sub
Private Function IsValidItalianVatNumber(ByVal str As String) As Boolean
 
 IsValidItalianVatNumber = False
 
 If Not IsNumeric(str) Then Exit Function
 If Not Len(str) = 11 Then Exit Function
 
 Dim X As Long
 Dim Y As Long
 Dim z As Long
 Dim t As Long
 Dim i As Long
 Dim c As Long
 Dim ch As Variant
 Dim pari As Boolean
 
 pari = True
 
 For i = 1 To Len(str) - 1
 pari = Not pari
 ch = CLng(Mid(str, i, 1))
 If pari Then
 Y = Y + (ch * 2)
 If ch > 4 Then z = z + 1
 Else
 X = X + ch
 End If
 Next i
 
 t = (X + Y + z) Mod 10
 c = (10 - t) Mod 10
 
 IsValidItalianVatNumber = (c = CLng(Right(str, 1)))
 
End Function
Private Function isValidIBAN(ByVal Iban As String) As Boolean
 
 ' Written by Davide Tonin
 ' Documentation at https://davidetonin.com/code-snippets/how-to-validate-an-iban-with-vba
 
 isValidIBAN = False
 
 Dim LengthByCountry As Long
 Dim ReorderedIBAN As String
 Dim NumericIBAN As String
 Dim ch As String
 Dim i As Long
 Const Div As Integer = 97
 Const SepaCountries As String = "AT20,BE16,BG22,CY28,HR21,DK18,EE20,FI18,FR27,DE22,GI23,GR27,GL18,IE22,IS26,FO18,IT27,LV21,LI21,LT20,LU20,MT31,MC27,NO15,NL18,PL28,PT25,GB22,CZ24,SK24,RO24,SM27,SI19,ES24,SE24,CH21,HU28"
 
 If Iban = vbNullString Then Exit Function
 
 'Check if the first 2 characters are letters
 If IsNumeric(Left(Iban, 1)) Or IsNumeric(Mid(Iban, 2, 1)) Then Exit Function
 
 'Get the expected legth by country
 LengthByCountry = InStr(1, SepaCountries, Left(Iban, 2), vbTextCompare)
 If LengthByCountry > 0 Then LengthByCountry = CInt(Mid(SepaCountries, LengthByCountry + 2, 2))
 
 If Len(Iban) <> LengthByCountry Then Exit Function
 
 'Move first 4 characters to right
 ReorderedIBAN = Right(Iban, Len(Iban) - 4) & Left(Iban, 4)
 
 'Loop through every single character in ReorderedIBAN and, if not numeric, return 10 based number from letter using string to store the returned value in place of number
 For i = 1 To Len(ReorderedIBAN)
 ch = Mid(ReorderedIBAN, i, 1)
 If Not IsNumeric(ch) Then
 NumericIBAN = NumericIBAN & CStr(Asc(UCase(ch)) - 55)
 Else
 NumericIBAN = NumericIBAN & CStr(ch)
 End If
 Next i
 
 ch = vbNullString
 
 'Perform primary school style division, digit by digit. I don't need to store the result, only the remainder
 For i = 1 To Len(NumericIBAN)
 ch = ch & Mid(NumericIBAN, i, 1)
 'If is the last character in NumericIBAN I check if remainder is 1 - Only fired once
 If i = Len(NumericIBAN) Then
 isValidIBAN = ((CLng(ch) Mod Div) = 1)
 Exit Function
 End If
 ch = IIf(CLng(ch) < Div, ch, CLng(ch) Mod Div)
 Next i
 
End Function
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
asked Jun 10, 2020 at 15:24
\$\endgroup\$

2 Answers 2

2
\$\begingroup\$

The art of Oop is that you have objects which have a simple, clear and unambiguous roles which can be composed together to achieve the result you want. You don't use objects as a convenient place to hide a pile of disconnected activities.

In the code you provide you have two main issues, collecting a text value and displaying the current validation status, and validating the incoming text value. Let's assume you are validating character by character.

I would have one object (a text gatherer) whose task it is to collect the text input. At initialisation, the text gatherer object would be provided with a validator object.

The text gatherer object provides each character to its validator object. The validator object has two functions.

  1. It indicates if the new character is accepted/not accepted according to the validation criteria.

  2. Triggers a input completed event once an input that matches the desired input has been achieved.

The Validator objects would be written so as to work through an IValidator interface to facilitate intellisense and compiler checking..

For VBA, if there are enumerations and constants that are used across multiple objects I would put these in the relevant interface, or a seperate helper class/module if there are also Methods used by all validator objects.

For the text gatherer object I might also want to split this into an object that just gets text and a second object that displays the current validation status.

answered Jun 11, 2020 at 7:12
\$\endgroup\$
2
  • \$\begingroup\$ Thank you very much! I'm quite new at OOP and this is the kind of suggestions that help to improve. At the moment the abstraction level that I'm confident with is lower than this, but maybe trying:) \$\endgroup\$ Commented Jun 11, 2020 at 11:34
  • \$\begingroup\$ Take a look at the blog articles on the Rubberduck VBA addin website (News). They are very helpful. \$\endgroup\$ Commented Jun 11, 2020 at 13:18
2
\$\begingroup\$

The one class is trying to handle multiple types of textboxes. In this specific case it would seem a better approach to create a class for each textbox type. This keeps code specific to each textbox type very isolated, focused, and much more OO. So, how to get there...

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.

IAdvTextBox

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

AdvTextBoxFactory

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

DecimalDigitTextBox

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

EmailTextBox

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
answered Jun 11, 2020 at 14:38
\$\endgroup\$
1
  • \$\begingroup\$ Thanks for the answer and the effort! I'm not understanding how an interface works, but I found some articles.. I'll be back as soon as I can understand the logic behind. Thank you! \$\endgroup\$ Commented Jun 11, 2020 at 15:26

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.