Excel VBA_类代码实例集锦

1,类动态数组控件‘2007VBA技巧‘快盘\Mytb\更新\类\类动态数组控件.xlsm‘2013-6-16类模块代码：PublicWithEventsfrmAsMSForms.UserFormPublicWithEventsmyTextAsMSForms.TextBoxPublicIndexAsIntegerPrivateSubmyText_Change()Index=Mid(myText.Name,8)Iffrm.Controls(Textbox&Index)Thenfrm.Label1.Caption=控件事件：Change&vbCrLf&_控件名称：&frm.Controls(Textbox&Index).Name&vbCrLf&_Text属性：&frm.Controls(Textbox&Index).TextEndIfEndSubPrivateSubmyText_DblClick(ByValCancelAsMSForms.ReturnBoolean)Index=Mid(myText.Name,8)Iffrm.Controls(Textbox&Index)Thenfrm.Label1.Caption=控件事件：DblClick&vbCrLf&_控件名称：&frm.Controls(Textbox&Index).Name&vbCrLf&_Cancel属性：&CancelEndIfEndSubKeyUp事件与Change事件重迭，二者取其一PrivateSubmyText_KeyUp(ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger)Index=Mid(myText.Name,8)Iffrm.Controls(Textbox&Index)Thenfrm.Label1.Caption=控件事件：KeyUp&vbCrLf&_控件名称：&frm.Controls(Textbox&Index).Name&vbCrLf&_按键值：&H&Hex$(KeyCode)EndIfEndSubPrivateSubmyText_MouseMove(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)SelectCaseIndexCase3Userform2.Label2.Caption=3Case8Userform2.Label2.Caption=8Case4Userform2.Label2.Caption=4Case9Userform2.Label2.Caption=9CaseElseUserform2.Label2.Caption=EndSelectEndSub模块1代码：Publica(1To14)AsmyTextSubformshow()Userform2.ShowEndSub窗体代码：PrivateSubCommandButton1_Click()Dimi&,t$Fori=1To14Ifa(i).myText.TextThent=t&控件名称：&a(i).myText.Name&vbTab&Text属性：&a(i).myText.Text&vbCrLfEndIfNextiMsgBoxtEndSubPrivateSubUserForm_Initialize()Dimi&Fori=1To14Seta(i)=NewmyTextSeta(i).myText=Me.Controls(Textbox&i)Seta(i).frm=MeNextiEndSub工作表代码：PrivateSubCommandButton1_Click()Userform2.ShowEndSub2,复选框选择‘快盘\Mytb\更新\类\类0928..xls‘当复选框选择到7个时，其它的复选框不能再选择。当复选框选择小于7个，其它的复选框还能继续选择。类模块代码：PublicWithEventscheAsMSForms.CheckBoxPublicWithEventsfrmAsMSForms.UserFormPrivateSubche_Change()'类的数据改变事件DimindexAsLongindex=Mid(che.Name,9)'取出checkboxN中的数字NIffrm.Controls(checkbox&index)=TrueThena=a&Format(index,00)&,n=n+1Ifn=7ThenFori=1To18b=Format(i,00)IfInStr(a,b)=0Thenfrm.Controls(checkbox&i).Enabled=FalseEndIfNextElseEndIfElsen=n-1a=Replace(a,Format(index,00),)Fori=1To18frm.Controls(checkbox&i).Enabled=TrueNextEndIfEndSub模块1代码：Publicnewclass(1To18)Asche类,n&,a$Subformshow()UserForm1.ShowEndSub窗体代码：PrivateSubUserForm_Initialize()Fori=1To18Setnewclass(i)=Newche类'创建一个新的che类对象Setnewclass(i).che=Controls(checkbox&i)'设置新类和checkbox(i)控件创建关键Setnewclass(i).frm=Me'类窗体也和当前窗体建立关联NextEndSub3,限制多个TEXTBOX的输入，使其只能输入数值‘快盘\Mytb\更新\类\如何限制多个TEXTBOX的输入_zhaogang1980.xls‘类模块代码：PublicWithEventsTxtboxAsMSForms.TextBoxPrivateSubTxtbox_Change()WithCreateObject(vbscript.regexp).Global=True.Pattern=[^0-9.]+If.test(Txtbox.Text)ThenTxtbox.Text=.Replace(Txtbox.Text,)EndIfEndWithEndSub模块1代码：SubMacro1()UserForm1.ShowEndSub窗体代码：DimTxt()AsNewclsTxtPrivateSubUserForm_Initialize()DimctlAsControl,m&ForEachctlInMe.ControlsIfTypeName(ctl)=TextBoxThenIfctl.NameTextBox1Thenm=m+1ReDimPreserveTxt(1Tom)SetTxt(m).Txtbox=ctlEndIfEndIfNextEndSubPrivateSubTextBox1_Exit(ByValCancelAsMSForms.ReturnBoolean)'第一个不需要类模块IfTextBox1.Text=ThenExitSubIfIsDate(TextBox1.Text)=FalseThenCancel=TrueTextBox1.Text=EndIfEndSub4，限制输入字母‘(ByValKeyAsciiAsMSForms.ReturnInteger)'限制只可以输入数字，不可输入字母和其他符号SelectCaseKeyAsciiCase48To57Case46IfInStr(1,t.Text,.)ThenKeyAscii=0EndIfCaseElseKeyAscii=0EndSelectEndSubPrivateSubt_KeyUp(ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger)'限制中文输入WithCreateObject(vbscript.regexp).Global=True.Pattern=[^0-9.]+If.test(t.Text)Thent.Text=.Replace(t.Text,)EndIfEndWithEndSubPublicSubtk(iAsOLEObject)'获取oleboject对象Sett=i.ObjectEndSubDimAr(1To100)AsTT'定义数组类Subjustest()DimjAsOLEObject,KAsByteForEachjInSheet1.OLEObjectsIfTypeName(j.Object)=TextBoxThen'如果为TEXTBOX控件j.Object.Text='清空文本框K=K+1:SetAr(K)=NewTT'同时创建类实体Ar(K).tkj'给类实体赋值，激活事件。EndIfNextEndSub5，表格上的按钮‘telnet_zhaogang1960。xls‘类模块clsCmd中代码：PublicWithEventsCmdboxAsMSForms.CommandButtonPrivateSubCmdbox_Click()MsgBoxCmdbox.CaptionEndSub‘表格1上的ActiveX按钮控件DimCmd(1To3)AsNewclsCmdPrivateSubWorksheet_Activate()DimiAsByteFori=1To3SetCmd(i).Cmdbox=Me.OLEObjects(CommandButton&i).ObjectNextEndSubPrivateSubWorksheet_Deactivate()EraseCmdEndSub6,求助由代码生成的控件的事件by:山菊花‘当光标移入某个文本框，这个文本框的背景色变为蓝色，前景改为白色‘类模块代码：PublicWithEventscmdAsMSForms.CommandButtonPublicWithEventsmBoxAsMSForms.TextBoxPrivateSubcmd_Click()DimctlAsMSForms.ControlWithUserForm1ForEachctlIn.ControlsIfTypeName(ctl)=TextBoxThenIfctl.NameTextBox1Then.Controls.Removectl.NameElseIfTypeName(ctl)=CommandButtonThenIfctl.NameCommandButton1Andctl.NameCommandButton2Then.Controls.Removectl.NameEndIfNext.CommandButton1.Enabled=True.CommandButton2.Enabled=FalseEndWithEndSubPrivateSubmBox_MouseDown(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)Fori=2To4WithUserForm1.Controls(TextBox&i).ForeColor=0.BackColor=16777215EndWithNextmBox.BackColor=16711680mBox.ForeColor=16777215EndSub窗体代码：Privated(1To4)AsNewcm