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

sspgyi

如果限制工作表中的文本框只能输入数字?如上述附件!请帮忙!

VBA万岁

Private Sub TextBox1_Change()
    Dim strFind As String
    strFind = "*" & UCase(Me.TextBox1.Text) & "*"
    If Len(TextBox1.Text) > 0 Then
         If Right(TextBox1.Text, 1) Like "[0-9]" Then Exit Sub Else Me.TextBox1.Text = Left(TextBox1.Text, Len(TextBox1.Text) - 1)
    End If
End Sub

VBA万岁

VBA万岁 发表于 2014-5-2 11:02
Private Sub TextBox1_Change()
    Dim strFind As String
    strFind = "*" & UCase(Me.TextBox1.Text ...

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

2014-5-2 11:03 上传

点击文件名下载附件

sspgyi

VBA万岁 发表于 2014-5-2 11:02
Private Sub TextBox1_Change()
    Dim strFind As String
    strFind = "*" & UCase(Me.TextBox1.Text ...

我想要的结果是要利用到附件中的类模块

VBA万岁

sspgyi 发表于 2014-5-2 11:08
我想要的结果是要利用到附件中的类模块

传上你的代码看看，我的电脑开你的附件时代码丢失，包括类模块。

sspgyi

VBA万岁 发表于 2014-5-2 11:22
传上你的代码看看，我的电脑开你的附件时代码丢失，包括类模块。

Option Explicit

Private WithEvents zdyTB As MSForms.TextBox


Public Sub Attach(IsTxtBox As MSForms.TextBox)
    Set zdyTB = IsTxtBox
End Sub
Private Sub zdyTB_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode >= 48 And KeyCode <= 57 Then
        MsgBox "输入有误,请重新输入[只能为数字]!   ", 48, "错误信息"
    End If
    If KeyCode >= 96 And KeyCode <= 57 Then
        MsgBox "输入有误,请重新输入[只能为数字]!   ", 48, "错误信息"
    End If
End Sub

sspgyi

上述附件!文本框在工作表中!

VBA万岁

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

如果是窗体中的文本框，还好解决，工作表中的文本框，研究了半天，毫无所获。
所以，还是一起期待高人出现！

VBA万岁

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

经求助他人，终于得到了解决，代码如下：
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 11:45
上述附件!文本框在工作表中!

Sheet1代码：
Dim Txt() As New clsTxt

Private Sub Worksheet_Activate()
    Call clsStart
End Sub

Private Sub Worksheet_Deactivate()
    Call clsEnd
End Sub

Sub clsStart()
    Dim tb As OLEObject, arr(), i%
    For Each tb In Me.OLEObjects
        If TypeName(tb.Object) = "TextBox" Then
            i = i + 1
            ReDim Preserve Txt(1 To i)
            Set Txt(i).Txtbox = tb.Object
        End If
    Next
End Sub

Sub clsEnd()
    Erase Txt
End Sub