use a function in multiple textbox

[amiroo]

Hi

I have a userform with 4 textbox and a function to force users input only number in it.
As code below shows, I have to right this function for each textbox keypress event.
Now I need to know is this possible to have a loop through userform textboxes to do it?

Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    OnlyNumber KeyAscii, Me.TextBox1
End Sub


Function OnlyNumber(key As MSForms.ReturnInteger, tb As MSForms.TextBox)
    If key > Asc("9") Or key < Asc("0") Then
        If key = Asc("-") Then
            If InStr(1, tb.Text, "-") > 0 Or _
               tb.SelStart > 0 Then key = 0
        ElseIf key = Asc(".") Then
            If InStr(1, tb.Text, ".") > 0 Then key = 0
        Else
            key = 0
        End If
    End If
End Function

 

[ranman256]

You could check if they used a number in the afterupdate,

sub txtBox1_afterupdate()
  If not IsNumeric(txtBox1) then MsgBox "enter only numbers."
end. Sub

 

[amiroo]

You could check if they used a number in the afterupdate,

sub txtBox1_afterupdate()
  If not IsNumeric(txtBox1) then MsgBox "enter only numbers."
end. Sub

thanks but it's not my question. I have to do it on keypress event and I need a loop to check it on any textbox in my userform
does anybody else can help me?

 

[ranman256]

Why must it be at key press?

 

[amiroo]

Why must it be at key press?

it's for user friendly goal.

 

[Jaafar Tribak]

it's for user friendly goal.

Only 4 textboxes is not many ... Why not put the following line in each textbox KeyPress event ?
OnlyNumber KeyAscii, Me.TextBox1
OnlyNumber KeyAscii, Me.TextBox2
OnlyNumber KeyAscii, Me.TextBox3
OnlyNumber KeyAscii, Me.TextBox4

Alternatively, you would use a generic class event or you could use a single loop in the UserForm Activate event withe some API calls.

 

[amiroo]

Only 4 textboxes is not many ... Why not put the following line in each textbox KeyPress event ?
OnlyNumber KeyAscii, Me.TextBox1
OnlyNumber KeyAscii, Me.TextBox2
OnlyNumber KeyAscii, Me.TextBox3
OnlyNumber KeyAscii, Me.TextBox4

Alternatively, you would use a generic class event or you could use a single loop in the UserForm Activate event withe some API calls.

that's for example. it may be 14 or even more. and also it may created while running form (for example by clicking on a button a textbox creates)

would you please tell me how to do it? I tried to create a loop in the userform unsuccessfully

 

[Jaafar Tribak]

that's for example. it may be 14 or even more. and also it may created while running form (for example by clicking on a button a textbox creates)

would you please tell me how to do it? I tried to create a loop in the userform unsuccessfully

Hi amiroo,

I can think of two ways of achieving this : either Using a seperate Class module or using a loop in the Userform Activate Event.

Using the class module method :

1- Add a new Class Module to your project, give the module the name of CtextBoxEvents and place the following code in it :

Option Explicit

Public WithEvents txtbx As MSForms.TextBox

Private Sub txtbx_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    OnlyNumber KeyAscii, txtbx
End Sub

Private Function OnlyNumber(key As MSForms.ReturnInteger, tb As MSForms.TextBox)
    If key > Asc("9") Or key < Asc("0") Then
        If key = Asc("-") Then
            If InStr(1, tb.Text, "-") > 0 Or _
               tb.SelStart > 0 Then key = 0
        ElseIf key = Asc(".") Then
            If InStr(1, tb.Text, ".") > 0 Then key = 0
        Else
            key = 0
        End If
    End If
End Function

2- Code in your UserForm Module :

Option Explicit

Private oCol As New Collection

Private Sub UserForm_Initialize()
    Dim oCtrl As Control
    
    For Each oCtrl In Me.Controls
        If TypeName(oCtrl) = "TextBox" Then
            Call HookTextBox(oCtrl)
        End If
    Next
End Sub

Private Sub UserForm_AddControl(ByVal Control As MSForms.Control)
    If TypeName(Control) = "TextBox" Then
        Call HookTextBox(Control)
    End If
End Sub

Private Sub HookTextBox(ByVal TextBox As MSForms.TextBox)
    Dim oClassInstance As CtextBoxEvents

    Set oClassInstance = New CtextBoxEvents
    Set oClassInstance.txtbx = TextBox
    oCol.Add oClassInstance
End Sub

See the loop method in the next post .

 

[Jaafar Tribak]

Loop method

In you userform module :

Option Explicit

Private Type POINTAPI
        x As Long
        y As Long
End Type

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Type MSG
        hwnd As LongPtr
        message As Long
        wParam As LongPtr
        lParam As LongPtr
        time As Long
        pt As POINTAPI
    End Type
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Type MSG
        hwnd As Long
        message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL]  VBA7 Then
    Private Declare PtrSafe Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    Private Declare PtrSafe Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As LongPtr
    Private Declare PtrSafe Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare PtrSafe Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As LongPtr) As Long
    Private hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL] 
    Private Declare Function GetMessage Lib "user32" Alias "GetMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long) As Long
    Private Declare Function DispatchMessage Lib "user32" Alias "DispatchMessageA" (lpMsg As MSG) As Long
    Private Declare Function TranslateMessage Lib "user32" (lpMsg As MSG) As Long
    Private Declare Function WindowFromAccessibleObject Lib "oleacc" (ByVal pacc As IAccessible, phwnd As Long) As Long
    Private hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL]  If

Private Const WM_KEYFIRST = &H100
Private Const WM_KEYLAST = &H108

Private bClosing As Boolean

Private Sub UserForm_Activate()

[B][COLOR=#008000]' PLACE ANY PRE-EXISTING CODE HERE BEFORE RUNNING THE LOOP !!!!!![/COLOR][/B]

     Dim tMsg As MSG

    bClosing = False
    WindowFromAccessibleObject Me, hwnd
    Do While GetMessage(tMsg, hwnd, 0, 0) And bClosing = False
        If TypeName(RealActiveControl) = "TextBox" Then RealActiveControl.Locked = True
        DoEvents
        DispatchMessage tMsg
        Call TranslateMessage(tMsg)
        If tMsg.message >= WM_KEYFIRST And tMsg.message <= WM_KEYLAST Then
            If IsNumeric(Chr(CLng(tMsg.wParam))) Or CLng(tMsg.wParam) = 46 Or CLng(tMsg.wParam) = 8 Then
                RealActiveControl.Locked = False
                DispatchMessage tMsg
                RealActiveControl.Locked = True
            End If
        End If
    Loop
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    bClosing = True
End Sub

Private Function RealActiveControl() As Control
    Dim oControl As Object
    
    On Error Resume Next
    Set oControl = ActiveControl
    Do
        Set oControl = CallByName(oControl, "ActiveControl", VbGet)
        DoEvents
    Loop Until Err.Number <> 0
    Set RealActiveControl = oControl
End Function

Note that although this method is more self-contained, it won't work for textboxes located in Multipage controls .