Same macro for multiple textboxes on the same userform excel vba

问题

I am currently making an userform in which I got multiple textboxes. So for now I got a total of 15 textboxes and each of them should only contain numerical values. The code I got now for each TextBox is:

    Private Sub TextBox1_Change()
     If TypeName(Me.ActiveControl) = "TextBox" Then

            With Me.ActiveControl

                If Not IsNumeric(.Value) And .Value <> vbNullString Then

                    MsgBox "Sorry, only numbers allowed"

                    .Value = vbNullString

                End If

            End With

        End If
    End Sub

    Private Sub TextBox2_Change()
     If TypeName(Me.ActiveControl) = "TextBox" Then

            With Me.ActiveControl

                If Not IsNumeric(.Value) And .Value <> vbNullString Then

                    MsgBox "Sorry, only numbers allowed"

                    .Value = vbNullString

                End If

            End With

        End If
    End Sub
.
.
.

Private Sub TextBox15_Change()
 If TypeName(Me.ActiveControl) = "TextBox" Then

        With Me.ActiveControl

            If Not IsNumeric(.Value) And .Value <> vbNullString Then

                MsgBox "Sorry, only numbers allowed"

                .Value = vbNullString

            End If

        End With

    End If
End Sub

The way I am doing it now feels kind of sloppy since I am copying the same code for each textbox. My question is therefor whether it is possible to consolidate these routines so that I will only require one code for all off the TextBoxes?

Kind regards and thanks in advance,

Maurice

回答1:

Simple example:

Add a new class module to your project and rename it NumericTextbox. Paste this code into it:

Option Explicit
Private WithEvents tb As MSForms.TextBox
Public Property Set TextControl(t As MSForms.TextBox)
    Set tb = t
End Property
Private Sub tb_Change()

    With tb

        If Not IsNumeric(.Value) And .Value <> vbNullString Then

            MsgBox "Sorry, only numbers allowed"

            .Value = vbNullString

        End If

    End With

End Sub

Now in your userform, add this code:

Option Explicit
Private colTBs                As Collection
Private Sub UserForm_Initialize()
    Dim ctl                   As MSForms.Control
    Dim oHandler              As NumericTextbox
    Set colTBs = New Collection

    For Each ctl In Me.Controls
        If TypeOf ctl Is MSForms.TextBox Then
            Set oHandler = New NumericTextbox
            Set oHandler.TextControl = ctl
            colTBs.Add oHandler
        End If
    Next ctl
End Sub

and there you go.

回答2:

I just passed the textbox as an argument into my function as follows:

sheet code

Private Sub TextBox1_Change()

test Me.TextBox1

End Sub

Private Sub TextBox2_Change()

test Me.TextBox2

End Sub

Module code:

Sub test(textbox As Object)

    With textbox

        If Not IsNumeric(.Value) And .Value <> vbNullString Then

            MsgBox "Sorry, only numbers allowed"

            .Value = vbNullString

        End If

    End With

End Sub

回答3:

The easy way would be to have a handler for each of the text boxes so that a particular procedure follows each individual action, I would suggest separating your procedure as the following

Private Sub checkValue()
With Me.ActiveControl
            If Not IsNumeric(.Value) And .Value <> vbNullString Then
                MsgBox "Sorry, only numbers allowed"
                .Value = vbNullString
            End If
        End With
End Sub

`Then call that sub from each of the textbox_change() procedures

来源：https://stackoverflow.com/questions/34595581/same-macro-for-multiple-textboxes-on-the-same-userform-excel-vba