《excel-vba-类代码实例集锦》由会员分享，可在线阅读，更多相关《excel-vba-类代码实例集锦（40页珍藏版）》请在金锄头文库上搜索。
1、1, 类动态数组控件 2007VBA技巧快盘Mytb更新类类动态数组控件.xlsm2013-6-16类模块代码：Public WithEvents frm As MSForms.UserFormPublic WithEvents myText As MSForms.TextBoxPublic Index As IntegerPrivate Sub myText_Change()Index = Mid(myText.Name, 8)If frm.Controls(Textbox & Index) Then frm.Label1.Caption = 控件事件：Change & vbCrLf & _
2、 控件名称： & frm.Controls(Textbox & Index).Name & vbCrLf & _ Text属性： & frm.Controls(Textbox & Index).TextEnd IfEnd SubPrivate Sub myText_DblClick(ByVal Cancel As MSForms.ReturnBoolean)Index = Mid(myText.Name, 8)If frm.Controls(Textbox & Index) Then frm.Label1.Caption = 控件事件：DblClick & vbCrLf & _ 控件名称： &
3、 frm.Controls(Textbox & Index).Name & vbCrLf & _ Cancel属性： & CancelEnd IfEnd SubKeyUp事件与Change事件重迭，二者取其一Private Sub myText_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)Index = Mid(myText.Name, 8)If frm.Controls(Textbox & Index) Then frm.Label1.Caption = 控件事件：KeyUp & vbCrLf &
4、_ 控件名称： & frm.Controls(Textbox & Index).Name & vbCrLf & _ 按键值：&H & Hex$(KeyCode)End IfEnd SubPrivate Sub myText_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)Select Case IndexCase 3 Userform2.Label2.Caption = 3Case 8Userform2.Label2.Caption = 8Case 4
5、 Userform2.Label2.Caption = 4Case 9 Userform2.Label2.Caption = 9Case Else Userform2.Label2.Caption = End SelectEnd Sub模块1代码：Public a(1 To 14) As myTextSub formshow()Userform2.ShowEnd Sub窗体代码：Private Sub CommandButton1_Click()Dim i&, t$For i = 1 To 14 If a(i).myText.Text Then t = t & 控件名称： & a(i).myT
6、ext.Name & vbTab & Text属性： & a(i).myText.Text & vbCrLf End IfNext iMsgBox tEnd SubPrivate Sub UserForm_Initialize()Dim i&For i = 1 To 14 Set a(i) = New myText Set a(i).myText = Me.Controls(Textbox & i) Set a(i).frm = MeNext iEnd Sub工作表代码：Private Sub CommandButton1_Click()Userform2.ShowEnd Sub2, 复选框选
7、择 快盘Mytb更新类类0928.xls当复选框选择到7个时，其它的复选框不能再选择。当复选框选择小于7个，其它的复选框还能继续选择。类模块代码：Public WithEvents che As MSForms.CheckBoxPublic WithEvents frm As MSForms.UserFormPrivate Sub che_Change() 类的数据改变事件 Dim index As Long index = Mid(che.Name, 9) 取出checkboxN中的数字N If frm.Controls(checkbox & index) = True Then a = a
8、 & Format(index, 00) & , n = n + 1 If n = 7 Then For i = 1 To 18 b = Format(i, 00) If InStr(a, b) = 0 Then frm.Controls(checkbox & i).Enabled = False End If Next Else End If Else n = n - 1 a = Replace(a, Format(index, 00), ) For i = 1 To 18 frm.Controls(checkbox & i).Enabled = True Next End IfEnd Su
9、b模块1代码：Public newclass(1 To 18) As che类, n&, a$Sub formshow()UserForm1.ShowEnd Sub窗体代码：Private Sub UserForm_Initialize() For i = 1 To 18 Set newclass(i) = New che类 创建一个新的che类对象 Set newclass(i).che = Controls(checkbox & i) 设置新类和checkbox(i)控件创建关键 Set newclass(i).frm = Me 类窗体也和当前窗体建立关联 Next End Sub3, 限
10、制多个TEXTBOX的输入，使其只能输入数值 快盘Mytb更新类如何限制多个TEXTBOX的输入_zhaogang1980.xlshttp:/ WithEvents Txtbox As MSForms.TextBoxPrivate Sub Txtbox_Change() With CreateObject(vbscript.regexp) .Global = True .Pattern = 0-9.+ If .test(Txtbox.Text) Then Txtbox.Text = .Replace(Txtbox.Text, ) End If End WithEnd Sub模块1代码：Sub
11、Macro1()UserForm1.ShowEnd Sub窗体代码：Dim Txt() As New clsTxtPrivate Sub UserForm_Initialize() Dim ctl As Control, m& For Each ctl In Me.Controls If TypeName(ctl) = TextBox Then If ctl.Name TextBox1 Then m = m + 1 ReDim Preserve Txt(1 To m) Set Txt(m).Txtbox = ctl End If End If NextEnd SubPrivate Sub Te
12、xtBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) 第一个不需要类模块 If TextBox1.Text = Then Exit Sub If IsDate(TextBox1.Text) = False Then Cancel = True TextBox1.Text = End IfEnd Sub4，限制输入字母 http:/ WithEvents t As MSForms.TextBoxPrivate Sub t_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)限制只可以输入数字，不可输入字母和其他符号Select Case KeyAsciiCase 48 To 57Case 46 If InStr(1, t.Text, .) Then KeyAscii = 0 End IfCase Else KeyAscii = 0End SelectEnd SubPrivate Sub t_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)限制中文输入With CreateObject(vb
