第6章--控件与用户窗体代码【超实用VBA】

42第6章控件与用户窗体范例67文本框只能输入数值PrivateSubTextBox1_KeyPress(ByValKeyANSIAsMSForms.ReturnInteger)WithTextBox1SelectCaseKeyANSICaseAsc(0)ToAsc(9)CaseAsc(-)IfInStr(1,.Text,-)0Or.SelStart0ThenKeyANSI=0EndIfCaseAsc(.)IfInStr(1,.Text,.)0ThenKeyANSI=0CaseElseKeyANSI=0EndSelectEndWithEndSubPrivateSubTextBox1_Change()DimiAsIntegerDimStrAsStringWithTextBox1Fori=1ToLen(.Text)Str=Mid(.Text,i,1)SelectCaseStrCase.,-,0To9CaseElse.Text=Replace(.Text,Str,)EndSelectNextEndWithEndSub43范例68限制文本框的输入长度PrivateSubTextBox1_Change()TextBox1.MaxLength=6EndSub范例69验证文本框输入的数据PrivateSubCommandButton1_Click()WithTextBox1If(Len(Trim(.Text)))=15Or(Len(Trim(.Text)))=18ThenCells(Rows.Count,1).End(xlUp).Offset(1,0)=.TextElseMsgBox身份证号码错误，请重新输入!EndIf.Text=.SetFocusEndWithEndSub范例70文本框回车自动输入PrivateSubTextBox1_KeyDown(ByValKeyCodeAsMSForms.ReturnInteger,ByValShiftAsInteger)DimrAsIntegerr=Cells(Rows.Count,1).End(xlUp).RowWithTextBox1IfLen(Trim(.Text))0AndKeyCode=vbKeyReturnThenCells(r+1,1)=.Text.Text=EndIfEndWithEndSub范例71文本框的自动换行PrivateSubUserForm_Initialize()WithTextBox1.WordWrap=True44.MultiLine=True.Text=文本框是一个灵活的控件，受下列属性的影响：Text、_&MultiLine、WordWrap和AutoSize。&vbCrLf_&Text包含显示在文本框中的文本。&vbCrLf_&MultiLine控制文本框是单行还是多行显示文本。_&换行字符用于标识在何处结束一行并开始新的一行。_&如果MultiLine的值为False，则文本将被截断，_&而不会换行。如果文本的长度大于文本框的宽度，_&WordWrap允许文本框根据其宽度自动换行。&vbCrLf_&如果不使用WordWrap，当文本框在文本中遇到换行字符时，_&开始一个新行。如果关闭WordWrap，TextBox中可以有不能_&完全适合其宽度的文本行。文本框根据该宽度，显示宽度以_&内的文本部分，截断宽度以外的那文本部分。只有当_&MultiLine为True时，WordWrap才起作用。&vbCrLf_&AutoSize控制是否调节文本框的大小，以便显示所有文本。_&当文本框使用AutoSize时，文本框的宽度按照文本框中的_&文字量以及显示该文本的字体大小收缩或扩大。EndWithEndSub范例72格式化文本框数据PrivateSubTextBox1_Exit(ByValCancelAsMSForms.ReturnBoolean)TextBox1=Format(TextBox1,##,#0.00)EndSubPrivateSubTextBox2_Exit(ByValCancelAsMSForms.ReturnBoolean)TextBox2=Format(TextBox2,##,#0.00)EndSub范例73使控件始终位于可视区域PrivateSubWorksheet_SelectionChange(ByValTargetAsRange)DimrngAsRangeSetrng=ActiveWindow.VisibleRange.Cells(1)WithCommandButton1.Top=rng.Top.Left=rng.LeftEndWithWithCommandButton2.Top=rng.Top.Left=rng.Left+CommandButton1.Width45EndWithSetrng=NothingEndSub范例74高亮显示按钮控件PrivateSubCommandButton1_MouseMove(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)WithMe.CommandButton1.BackColor=&HFFFF00.Width=62.Height=62.Top=69.Left=31EndWithEndSubPrivateSubUserForm_MouseMove(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)WithMe.CommandButton1.BackColor=Me.BackColor.Width=60.Height=60.Top=70.Left=32EndWithEndSub范例75列表框添加列表项的方法75-1使用RowSource属性PrivateSubUserForm_Initialize()DimrAsIntegerr=Sheet3.Range(A1048576).End(xlUp).RowListBox1.RowSource=Sheet3!a1:a&rEndSub75-2使用ListFillRange属性SubListFillRange()46DimrAsIntegerr=Sheet3.Range(A1048576).End(xlUp).RowSheet1.ListBox1.ListFillRange=Sheet3!a1:a&rSheet1.Shapes(列表框).ControlFormat.ListFillRange=Sheet3!a1:a&rEndSub75-3使用List属性PrivateSubUserForm_Initialize()DimarrAsVariantDimrAsIntegerr=Sheet3.Range(A1048576).End(xlUp).Rowarr=Sheet3.Range(A1:A&r)ListBox1.List=arrEndSubSubList()DimarrAsVariantDimrAsIntegerDimMyObjAsObjectr=Sheet3.Range(A1048576).End(xlUp).Rowarr=Sheet3.Range(A1:A&r)SetMyObj=Sheet2.Shapes(列表框).ControlFormatMyObj.List=arrSetMyObj=NothingEndSub75-4使用AddItem方法PrivateSubUserForm_Initialize()DimrAsIntegerDimiAsIntegerr=Sheet3.Range(A1048576).End(xlUp).RowFori=1TorListBox1.AddItem(Sheet3.Cells(i,1))NextEndSubSubAddItem()DimrAsIntegerDimiAsIntegerr=Sheet3.Range(A1048576).End(xlUp).RowWithSheet2.Shapes(列表框).ControlFormat.RemoveAllItemsFori=1Tor47.AddItemSheet3.Cells(i,1)NextEndWithEndSub范例76去除列表项的空行和重复项PrivateSubUserForm_Initialize()DimrAsIntegerDimiAsIntegerDimMyColAsNewCollectionDimarr()AsVariantOnErrorResumeNextWithSheet1r=.Cells(.Rows.Count,1).End(xlUp).RowFori=1TorIfTrim(.Cells(i,1))ThenMyCol.AddItem:=Cells(i,1),key:=CStr(.Cells(i,1))EndIfNextEndWithReDimarr(1ToMyCol.Count)Fori=1ToMyCol.Countarr(i)=MyCol(i)NextListBox1.List=arrEndSub范例77移动列表框的列表项PrivateSubCommandButton1_Click()DimIndAsIntegerDimStrAsStringWithMe.ListBox1Ind=.ListIndexSelectCaseIndCase-1MsgBox请选择一行后再移动!Case0MsgBox已经是第一行了!CaseIs0Str=.List(Ind).List(Ind)=.List(Ind-1)48.List(Ind-1)=Str.ListIndex=Ind-1EndSelectEndWithEndSubPrivateSubCommandButton2_Click()DimIndAsIntegerDimStrAsStringWithListBox1Ind=.ListIndexSelectCaseIndCase-1MsgBox请选择一行后再移动!Case.ListCount-1MsgBox已经是最后下一行了!CaseIs.ListCount-1Str=.List(Ind).List(Ind)=.List(Ind+1).List(Ind+1)=Str.ListIndex=Ind+1EndSelectEndWithEndSubPrivateSubCommandButton3_Click()DimiAsIntegerFori=1ToListBox1.ListCountCells(i,1)=ListBox1.List(i-1)NextEndSub范例78允许多项选择的列表框PrivateSubUserForm_Initialize()DimarrAsVariantarr=Array(经理室,办公室,生技科,财务科,营业部,制水车间,污水厂,其他)WithMe.ListBox1.List=arr.MultiSelect=1.ListStyle=1EndWithEndSub49PrivateSubCommandButton1_Click()DimiAsIntegerDimStrAsStringFori=0ToListBox1.ListCount-1IfListBox1.Selected(i)=TrueThenStr=Str&ListBox1.List(i)&Chr(13)EndIfNextIfStrThenMsgBoxStrElseMsgBox至少需要选择一个部门!EndIfEndSub范例79多列列表框的设置PrivateSubUserForm_Initialize()DimrAsIntegerWithSheet3r=.Cells(.Rows.Count,1).End(xlUp).Row-1EndWithWithListBox1.ColumnCount=7.Colu