Restrict what someone types in a textbox - forms

Question

Here's what I want to do and I have a problem.
I want to restrict what an user types in certain textboxes. I want to leave him type only numbers but after 3 numbers to add a ";". (eg. 007;123;003;005;).
The problem is that my textbox Controls are generated through a bunch of code. So I can't or I don't know how to set an action to these controls.
The code I'm using to generate the controls is:
Set cControl = form.Controls("io" & masina).Add(
"Forms.Label.1", "lreper" & l & pagina, True)
With cControl
.Caption = "Reper"
.Width = 35
.Height = 9
.Top = 25 + k
.Left = 5
End With
Any ideas?
Thanks a lot!

Answer 1

You can use the key press event to restrict only numbers and the ";". Along with check conditions.
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
'// Numbers 0-9
Case 48 To 57
If Len(TextBox1.Text) = 3 And Right(TextBox1.Text, 3) Like "###" Then
KeyAscii = 0
GoTo DisplayFormatError
End If
'// Key ;
Case 59
If Len(TextBox1.Text) < 3 Or Not Right(TextBox1.Text, 3) Like "###" Then
KeyAscii = 0
GoTo DisplayFormatError
End If
Case Else
KeyAscii = 0
GoTo DisplayFormatError
End Select
Exit Sub
DisplayFormatError:
MsgBox "Please enter serial number in the format '000;000;000'", vbInformation, "Alert!"
End Sub
A better way would be to use a regular expression instead of the like method.
If you need help adding the events for your controls at runtime have a look at:
Add controls and events to form at runtime
EDIT (REQUEST BY TIAGO)
Dynamic creation of Userform and Textbox with keypress event. Uses modified example of above link. Credit to original author.
Add reference - Under Available References, click "Microsoft Visual Basic for Applications Extensibility" and click OK.
Option Explicit
Sub MakeForm()
Dim TempForm As Object ' VBComponent
Dim FormName As String
Dim NewTextBox As MSForms.TextBox
Dim TextLocation As Integer
Dim TextBoxName As String
'** Additional variable
Dim X As Integer
'Locks Excel spreadsheet and speeds up form processing
Application.VBE.MainWindow.Visible = False
Application.ScreenUpdating = False
'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(vbext_ct_MSForm)
'Set Properties for TempForm
With TempForm
.Properties("Caption") = "Temporary Form"
.Properties("Width") = 200
.Properties("Height") = 100
End With
FormName = TempForm.Name
TextBoxName = "MyTextBox"
'Add a CommandButton
Set NewTextBox = TempForm.Designer.Controls _
.Add("Forms.TextBox.1")
With NewTextBox
.Name = TextBoxName
.Left = 60
.Top = 40
End With
'Add an event-hander sub for the CommandButton
With TempForm.CodeModule
'** Add/change next 5 lines
'This code adds the commands/event handlers to the form
X = .CountOfLines
.InsertLines X + 1, "Private Sub " & TextBoxName & "_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)"
.InsertLines X + 2, "KeyAscii = KeyPress(" & TextBoxName & ".Text, KeyAscii)"
.InsertLines X + 3, "End Sub"
End With
'Show the form
VBA.UserForms.Add(FormName).Show
'Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
End Sub
Public Function KeyPress(ByVal strText As String, ByVal KeyAscii As Integer) As Integer
Select Case KeyAscii
'// Numbers 0-9
Case 48 To 57
If Len(strText) = 3 And Right(strText, 3) Like "###" Then
GoTo DisplayFormatError
End If
'// Key ;
Case 59
If Len(strText) < 3 Or Not Right(strText, 3) Like "###" Then
GoTo DisplayFormatError
End If
Case Else
GoTo DisplayFormatError
End Select
KeyPress = KeyAscii
Exit Function
DisplayFormatError:
KeyPress = 0
MsgBox "Please enter serial number in the format '000;000;000'", vbInformation, "Alert!"
End Function
ANOTHER METHOD (Using an event handler class)
Code in Userform:
Private colEventHandlers As Collection
Private Sub UserForm_Initialize()
'// New collection of events
Set colEventHandlers = New Collection
'// Add dynamic textbox
Set tbxNewTextbox = Me.Controls.Add("Forms.TextBox.1", "MyNewTextbox", True)
With tbxNewTextbox
.Top = 25
.Left = 5
End With
'// Add the event handler
Dim objEventHandler As TextboxEventHandler
Set objEventHandler = New TextboxEventHandler
Set objEventHandler.TextBox = tbxNewTextbox
colEventHandlers.Add objEventHandler
End Sub
And add a class module and rename it too "TextBoxEventHandler", then add the following code:
Private WithEvents tbxWithEvent As MSForms.TextBox
Public Property Set TextBox(ByVal oTextBox As MSForms.TextBox)
Set tbxWithEvent = oTextBox
End Property
Private Sub tbxWithEvent_Change()
End Sub
Private Sub tbxWithEvent_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
'// Numbers 0-9
Case 48 To 57
If Len(tbxWithEvent.Text) = 3 And Right(tbxWithEvent.Text, 3) Like "###" Then
GoTo DisplayFormatError
End If
'// Key ;
Case 59
If Len(tbxWithEvent.Text) < 3 Or Not Right(tbxWithEvent.Text, 3) Like "###" Then
GoTo DisplayFormatError
End If
Case Else
GoTo DisplayFormatError
End Select
Exit Sub
DisplayFormatError:
KeyAscii = 0
MsgBox "Please enter serial number in the format '000;000;000'", vbInformation, "Alert!"
End Sub

Answer 2

Try Dataannotations / metadata
More here: http://msdn.microsoft.com/en-us/library/ee256141.aspx

Answer 3

AFAIK and if i understood well, there is no way to handle this before user input.
Yet, you can use the TextBox_Exit event to format it afterwards. You can adapt this sample of code.

Answer 4

Although I'd never use dynamic controls unless strictly required, I got puzzled by this question... so I'm thinking of it as a challenge. :-)
Googled around and most answers falls into the same solution, however most of them comes with a 'I couldn't make it work' comment as well, including this one here in SO Assign on-click VBA function to a dynamically created button on Excel Userform.
Here's the code I built... which obviously does not work, otherwise I'd say it could be a solution. The problem on it is that the keypress method it creates dynamically is not called when should be. To test it, just paste the code into a VBA form named 'myForm'.
I kept the TextBox1_KeyPress only for testing purposes, to prove the usability of the text field validator (I'm sorry #Readfidy, your code didn't work for me as expected. I was able to add more than 3 numbers in a row).
In case anyone else is interested in making this code works... I'd be happy to thank ;-)
Option Explicit
Private Sub UserForm_Activate()
Dim sTextBoxName As String
Dim cControl As MSForms.TextBox
Dim sMetaFunction As String
Dim CodeModule
sTextBoxName = "lreper"
Set cControl = myForm.Controls.Add("Forms.TextBox.1", sTextBoxName, True)
With cControl
.Top = 25
.Left = 5
End With
sMetaFunction = "Private Sub " & sTextBoxName & "_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)" & vbCrLf & _
vbCrLf & _
vbTab & "Set KeyAscii = EvaluateText(myForm.Controls(" & sTextBoxName & "), KeyAscii)" & vbCrLf & _
vbCrLf & _
"End Sub"
Set CodeModule = ActiveWorkbook.VBProject.VBComponents.VBE.ActiveCodePane.CodeModule
CodeModule.InsertLines 60, sMetaFunction
End Sub
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Set KeyAscii = EvaluateText(myForm.Controls("TextBox1"), KeyAscii)
End Sub
Private Function EvaluateText(ByRef oTextBox As MSForms.TextBox, ByVal KeyAscii As MSForms.ReturnInteger) As MSForms.ReturnInteger
If ((Len(oTextBox.Text) + 1) / 4 = CInt((Len(oTextBox.Text) + 1) / 4)) Then
If KeyAscii <> 59 Then KeyAscii = 0
Else
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0
End If
If KeyAscii = 0 Then
MsgBox "Please enter serial number in the format '000;000;000'", vbInformation, "Alert!"
End If
End Function

Answer 5

USE THIS CODE : NO CLASS NEEDED !
USERFORM CODE
Private Function QNumber(ByRef oTextBox As MSForms.TextBox, ByVal KeyAscii As MSForms.ReturnInteger) As MSForms.ReturnInteger
On Error Resume Next
Select Case KeyAscii
Case 45 '"-"
If InStr(1, oTextBox.Text, "-") > 0 Or oTextBox.SelStart > 0 Then
KeyAscii = 0
End If
Case 46 '"."
If InStr(1, oTextBox.Text, ".") > 0 Then
KeyAscii = 0
End If
Case 48 To 57 '0-9"
Case Else
KeyAscii = 0
End Select
End Function
TEXTBOX CODE
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Set KeyAscii = QNumber(Me.Controls("TextBox1"), KeyAscii)
End Sub