关于利用类模块限制文本框输入的内容

VBA万岁

sspgyi 发表于 2014-5-2 11:45
上述附件!文本框在工作表中!

类模块（clsTxt）：
Public WithEvents Txtbox As MSForms.TextBox

Private Sub Txtbox_Change()
    Dim s As String, t As String, a, i As Integer
    s = Txtbox.Text
    If InStr(s, ".") Then
        If Left(s, 1) = "." Then
            Txtbox.Text = Mid(s, 2)
        Else
            a = Split(s, ".")
            If UBound(a) > 1 Then
                t = a(0) & "."
                For i = 1 To UBound(a)
                    t = t & a(i)
                Next
                Txtbox.Text = t
            End If
        End If
    End If
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[^0-9.]+"
        If .test(s) Then
            Txtbox.Text = .Replace(s, "")
        End If
    End With
    Txtbox.SelStart = Len(s)
End Sub

VBA万岁

sspgyi 发表于 2014-5-2 11:45
上述附件!文本框在工作表中!

附件：
test.rar (10.33 KB, 下载次数: 9)

2014-5-2 16:33 上传

点击文件名下载附件

VBA万岁

VBA万岁 发表于 2014-5-2 16:34
附件：

相关链接：
http://club.excelhome.net/thread-968033-2-1.html

sspgyi

VBA万岁 发表于 2014-5-2 16:34
附件：

你好!如果变成两个文本框,一个文本框只能输入数字,另一个只能输入字母,如何解决呢?请帮忙,谢谢!

VBA万岁

sspgyi 发表于 2014-5-2 19:02
你好!如果变成两个文本框,一个文本框只能输入数字,另一个只能输入字母,如何解决呢?请帮忙,谢谢!

增加一个类模块（clsTxt2）：

Public WithEvents Txtbox2 As MSForms.TextBox

Private Sub Txtbox2_Change()
    Dim s As String, t As String, a, i As Integer
    s = Txtbox2.Text
    If InStr(s, ".") Then
        If Left(s, 1) = "." Then
            Txtbox2.Text = Mid(s, 2)
        Else
            a = Split(s, ".")
            If UBound(a) > 1 Then
                t = a(0) & "."
                For i = 1 To UBound(a)
                    t = t & a(i)
                Next
                Txtbox2.Text = t
            End If
        End If
    End If
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = "[^A-z.]+"
        If .test(s) Then
            Txtbox2.Text = .Replace(s, "")
        End If
    End With
    Txtbox2.SelStart = Len(s)
End Sub

VBA万岁

sspgyi 发表于 2014-5-2 19:02
你好!如果变成两个文本框,一个文本框只能输入数字,另一个只能输入字母,如何解决呢?请帮忙,谢谢!

Sheet1代码改为：

Dim Txt() As New clsTxt
Dim Txt2() As New clsTxt2

Private Sub Worksheet_Activate()
    Call clsStart
End Sub

Private Sub Worksheet_Deactivate()
    Call clsEnd
End Sub

Sub clsStart()
'On Error Resume Next
    Dim tb As OLEObject, i%, j%
    For Each tb In Me.OLEObjects
        If TypeName(tb.Object) = "TextBox" Then
            If tb.Name = "TextBox1" Then
                i = i + 1
                ReDim Preserve Txt(1 To i)
                Set Txt(i).Txtbox = tb.Object
            Else
                j = j + 1
                ReDim Preserve Txt2(1 To j)
                Set Txt2(j).Txtbox2 = tb.Object
            End If
        End If
    Next
End Sub

Sub clsEnd()
    Erase Txt
    Erase Txt2
End Sub

VBA万岁

VBA万岁 发表于 2014-5-2 20:53
Sheet1代码改为：

Dim Txt() As New clsTxt

ThisWorkbook代码不变：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call Sheet1.clsEnd
End Sub

Private Sub Workbook_Open()
    Call Sheet1.clsStart
End Sub

VBA万岁

sspgyi 发表于 2014-5-2 19:02
你好!如果变成两个文本框,一个文本框只能输入数字,另一个只能输入字母,如何解决呢?请帮忙,谢谢!

请测试附件：
test.zip (16.74 KB, 下载次数: 5)

2014-5-2 20:55 上传

点击文件名下载附件