ExcelVBA类代码实例集锦Word文件下载.docx
《ExcelVBA类代码实例集锦Word文件下载.docx》由会员分享，可在线阅读，更多相关《ExcelVBA类代码实例集锦Word文件下载.docx（47页珍藏版）》请在冰豆网上搜索。
EndSub
KeyUp事件与Change事件重迭，二者取其一
PrivateSubmyText_KeyUp（ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger）
KeyUp"
vbCrLf&
Integer,
PrivateSubmyText_MouseMove（ByValButtonAsInteger,ByValShiftAs
ByValXAsSingle,ByValYAsSingle）
SelectCaseIndex
Case3
Userform2.Label2.Caption="
3"
Case8
8"
Case4
4"
Case9
9"
CaseElse
模块1代码：
Publica（1To14）AsmyText
Subformshow（）
Userform2.Show
窗体代码：
PrivateSubCommandButton1_Click（）
Dimi&
t$
Fori=1To14
属性：
Ifa（i）.myText.Text<
t=t&
a（i）.myText.Name&
vbTab&
Text
a（i）.myText.Text&
vbCrLf
Nexti
MsgBoxt
PrivateSubUserForm_Initialize（）
Seta（i）=NewmyText
Seta（i）.myText=Me.Controls（"
i）
Seta（i）.frm=Me
工作表代码：
2,复选框选择
‘快盘更新类类0928..xls
‘当复选框选择到7个时，其它的复选框不能再选择。
当复选框选择小于7个，其它的复
选框还能继续选择。
PublicWithEventscheAsMSForms.CheckBox
PrivateSubche_Change（）'
类的数据改变事件
DimindexAsLong
index=Mid（che.Name,9）'
取出checkboxN中的数字N
checkbox"
index）=TrueThen
a=a&
Format（index,"
00"
）&
"
n=n+1
Ifn=7Then
Fori=1To18
b=Format（i,"
）
IfInStr（a,b）=0Then
frm.Controls（"
i）.Enabled=False
Next
Else
n=n-1
a=Replace（a,Format（index,"
）,"
i）.Enabled=True
Publicnewclass（1To18）Asche类,n&
a$
UserForm1.Show
Setnewclass（i）=Newche类'
创建一个新的che类对象
Setnewclass（i）.che=Controls（"
i）'
设置新类和checkbox（i）控件创建关键
Setnewclass（i）.frm=Me'
类窗体也和当前窗体建立关联
3,限制多个TEXTBO的输入，使其只能输入数值
‘快盘更新类如何限制多个TEXTBO的输入_zhaogang1980.xls
‘
PublicWithEventsTxtboxAsMSForms.TextBox
PrivateSubTxtbox_Change（）
WithCreateObject（"
vbscript.regexp"
.Global=True
.Pattern="
[A0-9.]+"
If.test（Txtbox.Text）Then
Txtbox.Text=.Replace（Txtbox.Text,"
EndWith
SubMacro1（）
DimTxt（）AsNewclsTxt
DimctlAsControl,m&
ForEachctlInMe.Controls
IfTypeName（ctl）="
TextBox"
Ifctl.Name<
TextBox1"
ReDimPreserveTxt（1Tom）
SetTxt（m）.Txtbox=ctl
第一个不
PrivateSubTextBox1_Exit（ByValCancelAsMSForms.ReturnBoolean）需要类模块
IfTextBox1.Text="
ThenExitSub
IfIsDate（TextBox1.Text）=FalseThen
Cancel=True
TextBox1.Text="
4，限制输入字母
‘
PrivateWithEventstAsMSForms.TextBox
PrivateSubt_KeyPress（ByValKeyAsciiAsMSForms.ReturnInteger）'
限制只可以输入数字，不可输入字母和其他符号
SelectCaseKeyAscii
Case48To57
Case46
IfInStr（1,t.Text,"
."
）Then
KeyAscii=0
EndSelect
PrivateSubt_KeyUp（ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAs
Integer）
'
限制中文输入
.Pattern="
卜0-9.]+"
If.test（t.Text）Then
t.Text=.Replace（t.Text,"
PublicSubtk（iAsOLEObject）
获取oleboject对象
Sett=i.Object
DimAr（1To100）AsTT
定义数组类
Subjustest（）
DimjAsOLEObject,KAsByte
ForEachjInSheet1.OLEObjects
IfTypeName（j.Object）="
j.Object.Text="
清空文本框
K=K+1:
SetAr（K）=NewTT
同时创建类实体
Ar（K）.tkj
给类实体赋值，激活事件。
5，表格上的按钮
‘telnet_zhaogang1960。
xls
‘类模块clsCmd中代码：
PublicWithEventsCmdboxAsMSForms.CommandButton
PrivateSubCmdbox_Click（）
MsgBoxCmdbox.Caption
‘表格1上的ActiveX按钮控件
DimCmd（1To3）AsNewclsCmd
PrivateSubWorksheet_Activate（）
DimiAsByte
Fori=1To3
SetCmd（i）.Cmdbox=Me.OLEObjects（"
CommandButton"
i）.Object
PrivateSubWorksheet_Deactivate（）
EraseCmd
6,求助由代码生成的控件的事件by:
山菊花‘当光标移入某个文本框，这个文本框的背景色变为蓝色，前景改为白色
‘类模块代码：
PublicWithEventscmdAsMSForms.CommandButton
PublicWithEventsmBoxAsMSForms.TextBox
PrivateSubcmd_Click（）
DimctlAsMSForms.Control
WithUserForm1
ForEachctlIn.Controls
Then.Controls.Removectl.Name
ElseIfTypeName（ctl）="
<
CommandButton1"
Andctl.Name"
CommandButton2"
.CommandButton1.Enabled=True
.CommandButton2.Enabled=False
PrivateSubmBox_MouseDown（ByValButtonAsInteger,ByValShiftAsInteger,
Fori=2To4
WithUserForm1.Controls（"
.ForeColor=0
.BackColor=16777215
mBox.BackColor=16711680
mBox.ForeColor=16777215
Privated（1To4）AsNewcmd_Class
Setd（i）.mBox=Frame1.Controls.Add（"
forms.TextBox.1"
,True）
Withd（i）.mBox
.Left=10.Top=（i-1）*30+3
.Width=70
.Height=20
.Text=.Name
Setd（4）.cmd=Me.Controls.Add（"
forms.CommandButton.1"
Withd（4）.cmd
.Left=CommandButton2.Left
.Top=CommandButton2.Top+CommandButton2.Height
.Width=CommandButton2.Width
.Height=CommandButton2.Height
.Caption="
删除"
CommandButton1.Enabled=False
CommandButton2.Enabled=True
PrivateSubCommandButton2_Click（）
WithControls（"
TextBox1.Value=Val（TextBox1.Value）+Val（.Value）
7，窗体键盘
‘快盘更新类可否实现窗体键盘.xls
PublicsNameAsString
类模块CmdArray代码:
UserForm1.Controls（sName）.Text=UserForm1.Controls（sName）.Text&
cmd.Caption
类模块TxtArray代码：
PublicWithEventstxtAsMSForms.TextBox
PrivateSubtxt_MouseDown（ByValButtonAsInteger,ByValShiftAsInteger,
sName=txt.Name
PrivatearrCmd（0To10）AsCmdArray
PrivatearrTxt（1To4）AsTxtArray
DimiAsInteger
DimcmdNewAsCmdArray
DimtxtNewAsTxtArray
Fori=0To10
SetcmdNew=NewCmdArray
SetcmdNew.cmd=Me.Controls（"
SetarrCmd（i）=cmdNew
SetcmdNew=Nothing
Fori=1To4
SettxtNew=NewTxtArray
SettxtNew.txt=Me.Controls（"
SetarrTxt（i）=txtNew
SettxtNew=Nothing
快盘
8，横道图
更新类类入门横道图_a371014988.xls
Sub画线条（）
DimstAsWorksheet,arrAsRange,tgAsRange
Setst=Sheets（"
横道图"
Setarr=st.Range（"
A5:
A"
st.Range（"
A65536"
）.End（xlUp）.Row）
ForEachtgInarr
DimLiAsNew类1
Li.SDate=DateValue（tg.Offset（0,3））
Li.Edate=DateValue（tg.Offset（0,4））
Li.st=st
Li.target=tg
Li.arr=st.Range（Cells（2,7）,st.Cells（2,255）.End（xlToLeft））
IfLi.lineThenDebug.Printtg
类模块类1代码：
取左
Privatem_stAsWorksheet
PrivateM_SDateAsDate
PrivateM_EDateAsDate
PrivateM_targetAsRange
PrivateM_arrAsRange
ConstHeightAsInteger=3
PublicPropertyGetEdate（）AsDate
Edate=M_EDate
EndProperty
PublicPropertyLetEdate（valueAsDate）
M_EDate=value
PublicPropertyGetSDate（）AsDate
SDate=M_SDate
PublicPropertyLetSDate（valueAsDate）
M_SDate=value
PublicPropertyGetst（）AsWorksheet
Setst=m_st
PublicPropertyLetst（stvalueAsWorksheet）
Setm_st=stvalue
PublicPropertyGettarget（）AsRange
Settarget=M_target
PublicPropertyLettarget（tgvalueAsRange）
SetM_target=tgvalue
PublicPropertyGetarr（）AsRange
Setarr=M_arr
PublicPropertyLetarr（valueAsRange）
SetM_arr=value
PublicFunctionGetDateLineLeft（ByValStartDateAsDate）AsSingle
DimtgAsRange,StartPointLeftAsSingle,iAsInteger
IfIsDate（tg.value）Then
IfYear（StartDate）=Year（tg.value）AndMonth（StartDate）Month（tg.value）Then
IfDateValue（Year（StartDate）&
-"
Month（StartDate）&
1"
）=DateValue（tg.Value）Then
Debug.PrintDay（StartDate）
SelectCaseCInt（Day（StartDate））
CaseIs<
CInt（tg.Offset（1,0））
Fori=1Totg.Offset（1,0）.Column-1
StartPointLeft=StartPointLeftst.Columns（i）.Width
GetDateLineLeft=StartPointLeft（CInt（Day（StartDate））Mod10）*st.Columns（tg.Offset（1,0）.Column）.Width/10
ExitFunction
CaseIs=CInt（tg.Offset（1,0））
Fori=1Totg.Offset（1,0）.Column
StartPoin
升级会员 