Excel VBA类代码实例集锦.docx
- 文档编号:2891765
- 上传时间:2022-11-16
- 格式:DOCX
- 页数:49
- 大小:64.57KB
Excel VBA类代码实例集锦.docx
《Excel VBA类代码实例集锦.docx》由会员分享,可在线阅读,更多相关《Excel VBA类代码实例集锦.docx(49页珍藏版)》请在冰豆网上搜索。
ExcelVBA类代码实例集锦
1,类动态数组控件
‘2007VBA技巧
‘快盘\Mytb\更新\类\类动态数组控件.xlsm
‘2013-6-16
类模块代码:
PublicWithEventsfrmAsMSForms.UserForm
PublicWithEventsmyTextAsMSForms.TextBox
PublicIndexAsInteger
PrivateSubmyText_Change()
Index=Mid(myText.Name,8)
Iffrm.Controls("Textbox"&Index)<>""Then
frm.Label1.Caption="控件事件:
Change"&vbCrLf&_
"控件名称:
"&frm.Controls("Textbox"&Index).Name&vbCrLf&_
"Text属性:
"&frm.Controls("Textbox"&Index).Text
EndIf
EndSub
PrivateSubmyText_DblClick(ByValCancelAsMSForms.ReturnBoolean)
Index=Mid(myText.Name,8)
Iffrm.Controls("Textbox"&Index)<>""Then
frm.Label1.Caption="控件事件:
DblClick"&vbCrLf&_
"控件名称:
"&frm.Controls("Textbox"&Index).Name&vbCrLf&_
"Cancel属性:
"&Cancel
EndIf
EndSub
KeyUp事件与Change事件重迭,二者取其一
PrivateSubmyText_KeyUp(ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger)
Index=Mid(myText.Name,8)
Iffrm.Controls("Textbox"&Index)<>""Then
frm.Label1.Caption="控件事件:
KeyUp"&vbCrLf&_
"控件名称:
"&frm.Controls("Textbox"&Index).Name&vbCrLf&_
"按键值:
&H"&Hex$(KeyCode)
EndIf
EndSub
PrivateSubmyText_MouseMove(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)
SelectCaseIndex
Case3
Userform2.Label2.Caption="3"
Case8
Userform2.Label2.Caption="8"
Case4
Userform2.Label2.Caption="4"
Case9
Userform2.Label2.Caption="9"
CaseElse
Userform2.Label2.Caption=""
EndSelect
EndSub
模块1代码:
Publica(1To14)AsmyText
Subformshow()
Userform2.Show
EndSub
窗体代码:
PrivateSubCommandButton1_Click()
Dimi&,t$
Fori=1To14
Ifa(i).myText.Text<>""Then
t=t&"控件名称:
"&a(i).myText.Name&vbTab&"Text属性:
"&a(i).myText.Text&vbCrLf
EndIf
Nexti
MsgBoxt
EndSub
PrivateSubUserForm_Initialize()
Dimi&
Fori=1To14
Seta(i)=NewmyText
Seta(i).myText=Me.Controls("Textbox"&i)
Seta(i).frm=Me
Nexti
EndSub
工作表代码:
PrivateSubCommandButton1_Click()
Userform2.Show
EndSub
2,复选框选择
‘快盘\Mytb\更新\类\类0928..xls
‘当复选框选择到7个时,其它的复选框不能再选择。
当复选框选择小于7个,其它的复选框还能继续选择。
类模块代码:
PublicWithEventscheAsMSForms.CheckBox
PublicWithEventsfrmAsMSForms.UserForm
PrivateSubche_Change()'类的数据改变事件
DimindexAsLong
index=Mid(che.Name,9)'取出checkboxN中的数字N
Iffrm.Controls("checkbox"&index)=TrueThen
a=a&Format(index,"00")&","
n=n+1
Ifn=7Then
Fori=1To18
b=Format(i,"00")
IfInStr(a,b)=0Then
frm.Controls("checkbox"&i).Enabled=False
EndIf
Next
Else
EndIf
Else
n=n-1
a=Replace(a,Format(index,"00"),"")
Fori=1To18
frm.Controls("checkbox"&i).Enabled=True
Next
EndIf
EndSub
模块1代码:
Publicnewclass(1To18)Asche类,n&,a$
Subformshow()
UserForm1.Show
EndSub
窗体代码:
PrivateSubUserForm_Initialize()
Fori=1To18
Setnewclass(i)=Newche类'创建一个新的che类对象
Setnewclass(i).che=Controls("checkbox"&i)'设置新类和checkbox(i)控件创建关键
Setnewclass(i).frm=Me'类窗体也和当前窗体建立关联
Next
EndSub
3,限制多个TEXTBOX的输入,使其只能输入数值
‘快盘\Mytb\更新\类\如何限制多个TEXTBOX的输入_zhaogang1980.xls
‘
类模块代码:
PublicWithEventsTxtboxAsMSForms.TextBox
PrivateSubTxtbox_Change()
WithCreateObject("vbscript.regexp")
.Global=True
.Pattern="[^0-9.]+"
If.test(Txtbox.Text)Then
Txtbox.Text=.Replace(Txtbox.Text,"")
EndIf
EndWith
EndSub
模块1代码:
SubMacro1()
UserForm1.Show
EndSub
窗体代码:
DimTxt()AsNewclsTxt
PrivateSubUserForm_Initialize()
DimctlAsControl,m&
ForEachctlInMe.Controls
IfTypeName(ctl)="TextBox"Then
Ifctl.Name<>"TextBox1"Then
m=m+1
ReDimPreserveTxt(1Tom)
SetTxt(m).Txtbox=ctl
EndIf
EndIf
Next
EndSub
PrivateSubTextBox1_Exit(ByValCancelAsMSForms.ReturnBoolean)'第一个不需要类模块
IfTextBox1.Text=""ThenExitSub
IfIsDate(TextBox1.Text)=FalseThen
Cancel=True
TextBox1.Text=""
EndIf
EndSub
4,限制输入字母
‘
PrivateWithEventstAsMSForms.TextBox
PrivateSubt_KeyPress(ByValKeyAsciiAsMSForms.ReturnInteger)
'限制只可以输入数字,不可输入字母和其他符号
SelectCaseKeyAscii
Case48To57
Case46
IfInStr(1,t.Text,".")Then
KeyAscii=0
EndIf
CaseElse
KeyAscii=0
EndSelect
EndSub
PrivateSubt_KeyUp(ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger)
'限制中文输入
WithCreateObject("vbscript.regexp")
.Global=True
.Pattern="[^0-9.]+"
If.test(t.Text)Then
t.Text=.Replace(t.Text,"")
EndIf
EndWith
EndSub
PublicSubtk(iAsOLEObject)
'获取oleboject对象
Sett=i.Object
EndSub
DimAr(1To100)AsTT
'定义数组类
Subjustest()
DimjAsOLEObject,KAsByte
ForEachjInSheet1.OLEObjects
IfTypeName(j.Object)="TextBox"Then
'如果为TEXTBOX控件
j.Object.Text=""
'清空文本框
K=K+1:
SetAr(K)=NewTT
'同时创建类实体
Ar(K).tkj
'给类实体赋值,激活事件。
EndIf
Next
EndSub
5,表格上的按钮
‘telnet_zh
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- Excel VBA类代码实例集锦 VBA 代码 实例 集锦