第6章--控件與用戶窗體代碼

1、精選優(yōu)質(zhì)文檔傾情為你奉上精選優(yōu)質(zhì)文檔傾情為你奉上專心專注專業(yè)專心專注專業(yè)精選優(yōu)質(zhì)文檔傾情為你奉上專心專注專業(yè)第6章 控件與用戶窗體范例67 文本框只能輸入數(shù)值Private Sub TextBox1_KeyPress(ByVal KeyANSI As MSForms.ReturnInteger) With TextBox1 Select Case KeyANSI Case Asc(0) To Asc(9) Case Asc(-) If InStr(1, .Text, -) 0 Or .SelStart 0 Then KeyANSI = 0 End If Case Asc(.) If InStr

2、(1, .Text, .) 0 Then KeyANSI = 0 Case Else KeyANSI = 0 End Select End WithEnd SubPrivate Sub TextBox1_Change() Dim i As Integer Dim Str As String With TextBox1 For i = 1 To Len(.Text) Str = Mid(.Text, i, 1) Select Case Str Case ., -, 0 To 9 Case Else .Text = Replace(.Text, Str, ) End Select Next End

3、 WithEnd Sub范例68 限制文本框的輸入長度Private Sub TextBox1_Change() TextBox1.MaxLength = 6End Sub范例69 驗(yàn)證文本框輸入的數(shù)據(jù)Private Sub CommandButton1_Click() With TextBox1 If (Len(Trim(.Text) = 15 Or (Len(Trim(.Text) = 18 Then Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = .Text Else MsgBox 身份證號碼錯(cuò)誤，請重新輸入! End If .Text = .

4、SetFocus End WithEnd Sub范例70 文本框回車自動輸入Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) Dim r As Integer r = Cells(Rows.Count, 1).End(xlUp).Row With TextBox1 If Len(Trim(.Text) 0 And KeyCode = vbKeyReturn Then Cells(r + 1, 1) = .Text .Text = End If End With

5、End Sub范例71 文本框的自動換行Private Sub UserForm_Initialize() With TextBox1 .WordWrap = True .MultiLine = True .Text = 文本框是一個(gè)靈活的控件，受下列屬性的影響：Text、 _ & MultiLine、WordWrap和AutoSize。 & vbCrLf _ & Text 包含顯示在文本框中的文本。 & vbCrLf _ & MultiLine 控制文本框是單行還是多行顯示文本。 _ & 換行字符用于標(biāo)識在何處結(jié)束一行并開始新的一行。 _ & 如果 MultiLine 的值為False，則文

6、本將被截?cái)啵?_ & 而不會換行。如果文本的長度大于文本框的寬度， _ & WordWrap允許文本框根據(jù)其寬度自動換行。 & vbCrLf _ & 如果不使用 WordWrap，當(dāng)文本框在文本中遇到換行字符時(shí)， _ & 開始一個(gè)新行。如果關(guān)閉WordWrap，TextBox中可以有不能 _ & 完全適合其寬度的文本行。文本框根據(jù)該寬度，顯示寬度以 _ & 內(nèi)的文本部分，截?cái)鄬挾纫酝獾哪俏谋静糠?。只有?dāng) _ & MultiLine為True時(shí)，WordWrap才起作用。 & vbCrLf _ & AutoSize 控制是否調(diào)節(jié)文本框的大小，以便顯示所有文本。 _ & 當(dāng)文本框使用AutoSiz

7、e 時(shí)，文本框的寬度按照文本框中的 _ & 文字量以及顯示該文本的字體大小收縮或擴(kuò)大。 End WithEnd Sub范例72 格式化文本框數(shù)據(jù)Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox1 = Format(TextBox1, #,#0.00)End SubPrivate Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean) TextBox2 = Format(TextBox2, #,#0.00)End Sub范例73 使控件始終位于

8、可視區(qū)域Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range Set rng = ActiveWindow.VisibleRange.Cells(1) With CommandButton1 .Top = rng.Top .Left = rng.Left End With With CommandButton2 .Top = rng.Top .Left = rng.Left + CommandButton1.Width End With Set rng = NothingEnd Sub范例74

9、 高亮顯示按鈕控件Private Sub CommandButton1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single) With Me.CommandButton1 .BackColor = &HFFFF00 .Width = 62 .Height = 62 .Top = 69 .Left = 31 End WithEnd SubPrivate Sub UserForm_MouseMove(ByVal Button As Integer, ByVal

10、 Shift As Integer, ByVal X As Single, ByVal Y As Single) With Me.CommandButton1 .BackColor = Me.BackColor .Width = 60 .Height = 60 .Top = 70 .Left = 32 End WithEnd Sub范例75 列表框添加列表項(xiàng)的方法75-1 使用RowSource屬性Private Sub UserForm_Initialize() Dim r As Integer r = Sheet3.Range(A).End(xlUp).Row ListBox1.RowSo

11、urce = Sheet3!a1:a & rEnd Sub75-2 使用ListFillRange屬性Sub ListFillRange() Dim r As Integer r = Sheet3.Range(A).End(xlUp).Row Sheet1.ListBox1.ListFillRange = Sheet3!a1:a & r Sheet1.Shapes(列表框).ControlFormat.ListFillRange = Sheet3!a1:a & rEnd Sub75-3 使用List屬性Private Sub UserForm_Initialize() Dim arr As V

12、ariant Dim r As Integer r = Sheet3.Range(A).End(xlUp).Row arr = Sheet3.Range(A1:A & r) ListBox1.List = arrEnd SubSub List() Dim arr As Variant Dim r As Integer Dim MyObj As Object r = Sheet3.Range(A).End(xlUp).Row arr = Sheet3.Range(A1:A & r) Set MyObj = Sheet2.Shapes(列表框).ControlFormat MyObj.List =

13、 arr Set MyObj = NothingEnd Sub75-4 使用AddItem方法Private Sub UserForm_Initialize() Dim r As Integer Dim i As Integer r = Sheet3.Range(A).End(xlUp).Row For i = 1 To r ListBox1.AddItem (Sheet3.Cells(i, 1) NextEnd SubSub AddItem() Dim r As Integer Dim i As Integer r = Sheet3.Range(A).End(xlUp).Row With S

14、heet2.Shapes(列表框).ControlFormat .RemoveAllItems For i = 1 To r .AddItem Sheet3.Cells(i, 1) Next End WithEnd Sub范例76 去除列表項(xiàng)的空行和重復(fù)項(xiàng)Private Sub UserForm_Initialize() Dim r As Integer Dim i As Integer Dim MyCol As New Collection Dim arr() As Variant On Error Resume Next With Sheet1 r = .Cells(.Rows.Count

15、, 1).End(xlUp).Row For i = 1 To r If Trim(.Cells(i, 1) Then MyCol.Add Item:=Cells(i, 1), key:=CStr(.Cells(i, 1) End If Next End With ReDim arr(1 To MyCol.Count) For i = 1 To MyCol.Count arr(i) = MyCol(i) Next ListBox1.List = arrEnd Sub范例77 移動列表框的列表項(xiàng)Private Sub CommandButton1_Click() Dim Ind As Integ

16、er Dim Str As String With Me.ListBox1 Ind = .ListIndex Select Case Ind Case -1 MsgBox 請選擇一行后再移動! Case 0 MsgBox 已經(jīng)是第一行了! Case Is 0 Str = .List(Ind) .List(Ind) = .List(Ind - 1) .List(Ind - 1) = Str .ListIndex = Ind - 1 End Select End WithEnd SubPrivate Sub CommandButton2_Click() Dim Ind As Integer Dim

17、 Str As String With ListBox1 Ind = .ListIndex Select Case Ind Case -1 MsgBox 請選擇一行后再移動! Case .ListCount - 1 MsgBox 已經(jīng)是最后下一行了! Case Is .ListCount - 1 Str = .List(Ind) .List(Ind) = .List(Ind + 1) .List(Ind + 1) = Str .ListIndex = Ind + 1 End Select End WithEnd SubPrivate Sub CommandButton3_Click() Dim

18、 i As Integer For i = 1 To ListBox1.ListCount Cells(i, 1) = ListBox1.List(i - 1) NextEnd Sub范例78 允許多項(xiàng)選擇的列表框Private Sub UserForm_Initialize() Dim arr As Variant arr = Array(經(jīng)理室, 辦公室, 生技科, 財(cái)務(wù)科, 營業(yè)部, 制水車間, 污水廠, 其他) With Me.ListBox1 .List = arr .MultiSelect = 1 .ListStyle = 1 End WithEnd SubPrivate Sub

19、CommandButton1_Click() Dim i As Integer Dim Str As String For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) = True Then Str = Str & ListBox1.List(i) & Chr(13) End If Next If Str Then MsgBox Str Else MsgBox 至少需要選擇一個(gè)部門! End IfEnd Sub范例79 多列列表框的設(shè)置Private Sub UserForm_Initialize() Dim r As Int

20、eger With Sheet3 r = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 End With With ListBox1 .ColumnCount = 7 .ColumnWidths = 35,45,45,45,45,40,50 .BoundColumn = 1 .ColumnHeads = True .TextAlign = 3 .RowSource = Sheet3.Range(A2:G & r).Address(External:=True) End WithEnd SubPrivate Sub ListBox1_Click() Dim r

21、 As Integer Dim i As Integer With Sheet1 r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 For i = 1 To ListBox1.ColumnCount .Cells(r, i) = ListBox1.Column(i - 1) Next End WithEnd Sub范例80 二級組合框Private Sub UserForm_Initialize() Dim r As Integer Dim MyCol As New Collection Dim arr() As Variant Dim rng As R

22、ange Dim i As Integer On Error Resume Next r = Cells(Rows.Count, 1).End(xlUp).Row For Each rng In Range(A2:A & r) MyCol.Add rng, CStr(rng) Next ReDim arr(1 To MyCol.Count) For i = 1 To MyCol.Count arr(i) = MyCol(i) Next ComboBox1.List = arr ComboBox1.ListIndex = 0 Set MyCol = Nothing Set rng = Nothi

23、ngEnd SubPrivate Sub ComboBox1_Change() Dim MyAddress As String Dim rng As Range ComboBox2.Clear With Sheet1.Range(A:A) Set rng = .Find(What:=ComboBox1.Text) If Not rng Is Nothing Then MyAddress = rng.Address Do ComboBox2.AddItem rng.Offset(, 1) Set rng = .FindNext(rng) Loop While Not rng Is Nothing

24、 And rng.Address MyAddress End If End With ComboBox2.ListIndex = 0 Set rng = NothingEnd Sub范例81 使用RefEdit控件選擇區(qū)域Private Sub CommandButton1_Click() Dim rng As Range On Error Resume Next Set rng = Range(RefEdit1.Value) rng.Interior.ColorIndex = 16 Set rng = NothingEnd Sub范例82 使用多頁控件Private Sub UserForm

25、_Initialize() MultiPage1.Value = 0End SubPrivate Sub MultiPage1_Change() If MultiPage1.SelectedItem.Index 0 Then MsgBox 您選擇的是 & MultiPage1.SelectedItem.Caption & 頁面! End IfEnd Sub范例83 使用TabStrip控件Private Sub UserForm_Initialize() TabStrip1.Value = 0 TabStrip1.Style = 0End SubPrivate Sub TabStrip1_Ch

26、ange() Dim str As String Dim FilPath As String str = TabStrip1.SelectedItem.Caption FilPath = ThisWorkbook.Path & & str & .jpg Image1.Picture = LoadPicture(FilPath) Label1.Caption = str & 歡迎您!End Sub范例84 在框架中使用滾動條Private Sub UserForm_Initialize() With Frame1 .ScrollBars = 3 .ScrollHeight = Image1.He

27、ight .ScrollWidth = Image1.Width End WithEnd Sub范例85 制作進(jìn)度條Sub myProgressBar() Dim r As Integer Dim i As Integer With Sheet1 r = .Cells(.Rows.Count, 1).End(xlUp).Row UserForm1.Show 0 With UserForm1.ProgressBar1 .Min = 1 .Max = r .Scrolling = 0 End With For i = 1 To r .Cells(i, 3) = Round(.Cells(i, 1)

28、 * .Cells(i, 2), 2) Application.Goto Reference:=.Cells(i, 1), Scroll:=True UserForm1.ProgressBar1.Value = i UserForm1.Caption = 程序正在運(yùn)行,已完成 & Format(i / r) * 100, 0.00) & %,請稍候! Next End With Unload UserForm1End Sub范例86 使用DTP控件輸入日期Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Me.D

29、TPicker1 If Target.Count = 1 And Target.Column = 1 And Not Target.Row = 1 Or Target.MergeCells Then .Visible = True .Top = Selection.Top .Left = Selection.Left .Height = Selection.Height .Width = Selection.Width If Target.Cells(1, 1) Then .Value = Target.Cells(1, 1).Value Else .Value = Date End If E

30、lse .Visible = False End If End WithEnd SubPrivate Sub Worksheet_Change(ByVal Target As Range) If Target.Count = 1 And Target.Column = 1 Or Target.MergeCells Then If Target.Cells(1, 1).Value = Then DTPicker1.Visible = False End If End IfEnd SubPrivate Sub DTPicker1_CloseUp() ActiveCell.Value = Me.DT

31、Picker1.Value Me.DTPicker1.Visible = FalseEnd Sub范例87 使用spreadsheet控件Private Sub UserForm_Initialize() Dim r As Integer Dim arr As Variant Dim i As Integer With Sheet3 r = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range(A1:G & r) End With With Me.Spreadsheet1 .DisplayToolbar = False .DisplayWorkbo

32、okTabs = False .DisplayHorizontalScrollBar = False .DisplayVerticalScrollBar = True .Rows.RowHeight = 15 .Columns.ColumnWidth = 8 With .Range(A1:G & r) .Value = arr .HorizontalAlignment = -4108 .Borders.LineStyle = xlContinuous .Borders.ColorIndex = 10 .NumberFormat = 0.00 End With End WithEnd SubPr

33、ivate Sub CommandButton1_Click() Dim r As Integer Dim arr As Variant With Me.Spreadsheet1 r = .Cells(.Rows.Count, 1).End(xlUp).Row arr = .Range(A1:G & r) Sheet1.Range(A1:G & r) = arr End With Unload MeEnd SubSub RegWriteProc() Dim WshShell Set WshShell = CreateObject(Wscript.Shell) WshShell.RegWrite

34、 HKCUSoftwareMicrosoftOfficeCommonSecurityUFIControls, 1, REG_DWORD WshShell.RegWrite HKCUSoftwareMicrosoftVBASecurityLoadControlsInForms, 1, REG_DWORD Set WshShell = NothingEnd Sub范例88 使用TreeView控件顯示層次Private Sub UserForm_Initialize() Dim c As Integer Dim r As Integer Dim rng As Variant rng = Sheet

35、2.UsedRange With TreeView1 .Style = tvwTreelinesPlusMinusPictureText .LineStyle = tvwRootLines .CheckBoxes = False With .Nodes .Clear .Add Key:=科目, Text:=科目名稱 For c = 1 To Sheet2.UsedRange.Columns.Count For r = 2 To Sheet2.UsedRange.Rows.Count If Not IsEmpty(rng(r, c) Then If c = 1 Then .Add relativ

36、e:=科目, Relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c) ElseIf Not IsEmpty(rng(r, c - 1) Then .Add relative:=rng(r, c - 1), Relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c) Else .Add relative:=CStr(Sheet2.Cells(r, c - 1).End(xlUp), Relationship:=tvwChild, Key:=rng(r, c), Text:=rng(r, c

37、) End If End If Next Next End With End WithEnd SubPrivate Sub TreeView1_DblClick() Dim r As Integer With Sheet1 r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 If TreeView1.SelectedItem.Children = 0 Then .Range(A & r) = TreeView1.SelectedItem.Text Else MsgBox 您所選擇的不是末級科目,請重新選擇! End If End WithEnd Sub范例

38、89 使用Listview控件89-1 使用Listview控件顯示數(shù)據(jù)列表Private Sub UserForm_Initialize() Dim Itm As ListItem Dim r As Integer Dim i As Integer Dim c As Integer r = Cells(Rows.Count, 1).End(xlUp).Row With ListView1 .ColumnHeaders.Add , , 人員編號 , 50, 0 .ColumnHeaders.Add , , 技能工資 , 50, 1 .ColumnHeaders.Add , , 崗位工資 , 5

39、0, 1 .ColumnHeaders.Add , , 工齡工資 , 50, 1 .ColumnHeaders.Add , , 浮動工資 , 50, 1 .ColumnHeaders.Add , , 其他 , 50, 1 .ColumnHeaders.Add , , 應(yīng)發(fā)合計(jì), 50, 1 .View = lvwReport .Gridlines = True For i = 2 To r Set Itm = .ListItems.Add() Itm.Text = Space(2) & Cells(i, 1) For c = 1 To 6 Itm.SubItems(c) = Format(Ce

40、lls(i, c + 1), #,#,0.00) Next Next End With Set Itm = NothingEnd Sub89-2 在Listview控件中使用復(fù)選框Private Sub UserForm_Initialize() Dim Itm As ListItem Dim r As Integer Dim i As Integer Dim c As Integer r = Sheet2.Cells(Sheet2.Rows.Count, 1).End(xlUp).Row With ListView1 .ColumnHeaders.Add , , 人員編號 , 50, 0 .

41、ColumnHeaders.Add , , 技能工資 , 50, 1 .ColumnHeaders.Add , , 崗位工資 , 50, 1 .ColumnHeaders.Add , , 工齡工資 , 50, 1 .ColumnHeaders.Add , , 浮動工資 , 50, 1 .ColumnHeaders.Add , , 其他 , 50, 1 .ColumnHeaders.Add , , 應(yīng)發(fā)合計(jì), 50, 1 .View = lvwReport .Gridlines = True .FullRowSelect = True .CheckBoxes = True For i = 2 T

42、o r - 1 Set Itm = .ListItems.Add() Itm.Text = Sheet2.Cells(i, 1) For c = 1 To 6 Itm.SubItems(c) = Format(Sheet2.Cells(i, c + 1), #,#,0.00) Next Next End With Set Itm = NothingEnd SubPrivate Sub CommandButton1_Click() Dim r As Integer Dim i As Integer Dim c As Integer r = Cells(Rows.Count, 1).End(xlU

43、p).Row If r 1 Then Range(A2:G & r).ClearContents With ListView1 For i = 1 To .ListItems.Count If .ListItems(i).Checked Then Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = .ListItems(i) For c = 1 To 6 Cells(Rows.Count, c + 1).End(xlUp).Offset(1, 0) = .ListItems(i).SubItems(c) Next End If Next End With

44、End Sub89-3 調(diào)整Listview控件的行距Private Sub UserForm_Initialize() Dim Itm As ListItem Dim i As Integer Dim c As Integer Dim Img As ListImage With ListView1 .ColumnHeaders.Add , , 人員編號 , 50, 0 .ColumnHeaders.Add , , 技能工資 , 50, 1 .ColumnHeaders.Add , , 崗位工資 , 50, 1 .ColumnHeaders.Add , , 工齡工資 , 50, 1 .Colu

45、mnHeaders.Add , , 浮動工資 , 50, 1 .ColumnHeaders.Add , , 其他 , 50, 1 .ColumnHeaders.Add , , 應(yīng)發(fā)合計(jì), 50, 1 .View = lvwReport .Gridlines = True .FullRowSelect = True For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Set Itm = .ListItems.Add() Itm.Text = Space(2) & Cells(i, 1) For c = 1 To 6 Itm.SubItems(c) =

46、Format(Cells(i, c + 1), #,#,0.00) Next Next Set Img = ImageList1.ListImages.Add _ (Picture:=LoadPicture(ThisWorkbook.Path & & 125.bmp) .SmallIcons = ImageList1 End With Set Itm = Nothing Set Img = NothingEnd Sub89-4 在Listview控件中排序Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.Co

47、lumnHeader) With ListView1 .Sorted = True .SortOrder = (.SortOrder + 1) Mod 2 .SortKey = ColumnHeader.Index - 1 End WithEnd Sub89-5 Listview控件的圖標(biāo)設(shè)置Private Sub UserForm_Initialize() Dim ITM As ListItem Dim i As Integer With ListView1 .View = lvwIcon .Icons = ImageList1 For i = 2 To 6 Set ITM = .ListI

48、tems.Add() ITM.Text = Cells(i, 1) ITM.Icon = i - 1 Next End With Set ITM = NothingEnd SubPrivate Sub UserForm_Initialize() Dim ITM As ListItem Dim i As Integer With ListView1 .View = lvwSmallIcon .SmallIcons = ImageList1 For i = 2 To 6 Set ITM = .ListItems.Add() ITM.Text = Cells(i, 1) ITM.SmallIcon

49、= i - 1 Next End With Set ITM = NothingEnd Sub范例90 使用Toolbar控件添加工具欄Private Sub UserForm_Initialize() Dim arr As Variant Dim i As Byte arr = Array( 錄入 , 審核, 記賬 , 結(jié)賬 , 負(fù)債表, 損益表) With Toolbar1 .ImageList = ImageList1 .Appearance = ccFlat .BorderStyle = ccNone .TextAlignment = tbrTextAlignBottom With .B

50、uttons .Add(1, , ).Style = tbrPlaceholder For i = 0 To UBound(arr) .Add(i + 2, , , , i + 1).Caption = arr(i) Next End With End WithEnd Sub范例91 使用StatusBar控件添加狀態(tài)欄Private Sub UserForm_Initialize() Dim Pal As Panel Dim arr1 As Variant Dim arr2 As Variant Dim i As Integer arr1 = Array(0, 6, 5) arr2 = Ar

51、ray(180, 60, 54) StatusBar1.Width = 294 For i = 1 To 3 Set Pal = StatusBar1.Panels.Add() With Pal .Style = arr1(i - 1) .Width = arr2(i - 1) .Alignment = i - 1 End With Next StatusBar1.Panels(1).Text = 準(zhǔn)備就緒!End SubPrivate Sub TextBox1_Change() StatusBar1.Panels(1).Text = 正在輸入： & TextBox1.TextEnd Sub范

52、例92 使用AniGif控件顯示GIF圖片Private Sub CommandButton1_Click() AniGif1.Stretch = True AniGif1.Filename = ThisWorkbook.Path & 001.gifEnd Sub范例93 使用ShockwaveFlash控件播放Flash文件Private Sub CommandButton1_Click() With ShockwaveFlash1 .Movie = ThisWorkbook.Path & 001.swf .EmbedMovie = False .Menu = False .ScaleMod

53、e = 2 End WithEnd SubPrivate Sub CommandButton2_Click() ShockwaveFlash1.PlayEnd SubPrivate Sub CommandButton3_Click() ShockwaveFlash1.ForwardEnd SubPrivate Sub CommandButton4_Click() ShockwaveFlash1.StopEnd SubPrivate Sub CommandButton5_Click() ShockwaveFlash1.BackEnd SubPrivate Sub CommandButton6_C

54、lick() ShockwaveFlash1.Movie = End SubPrivate Sub CommandButton7_Click() Unload MeEnd Sub范例94 注冊自定義控件Sub Regsvrs() Dim SouFile As String Dim DesFile As String On Error Resume Next SouFile = ThisWorkbook.Path & VBAniGIF.OCX DesFile = C:Windowssystem32VBAniGIF.OCX FileCopy SouFile, DesFile Shell REGSV

55、R32 /s & DesFile MsgBox AniGif控件已成功注冊，現(xiàn)在可以使用了!End SubSub Regsvru() Shell REGSVR32 /u C:Windowssystem32VBAniGIF.OCXEnd Sub范例95 不打印工作表中的控件范例96 遍歷控件的方法96-1 使用名稱中的變量Private Sub CommandButton1_Click() Dim i As Integer For i = 1 To 3 Me.Controls(TextBox & i) = NextEnd SubSub ClearText() Dim i As Integer F

56、or i = 1 To 4 Sheet1.OLEObjects(TextBox & i).Object.Text = NextEnd Sub96-2 使用對象類型Private Sub CommandButton1_Click() Dim Ctr As Control For Each Ctr In Me.Controls If TypeName(Ctr) = TextBox Then Ctr = End If Next Set Ctr = NothingEnd SubSub ClearText() Dim Obj As OLEObject For Each Obj In Sheet1.OLE

57、Objects If TypeName(Obj.Object) = TextBox Then Obj.Object.Text = End If Next Set Obj = NothingEnd Sub96-3 使用程序標(biāo)識符Sub ClearText() Dim Obj As OLEObject For Each Obj In Sheet1.OLEObjects If OgID = Forms.TextBox.1 Then Obj.Object.Text = End If Next Set Obj = NothingEnd Sub96-4 使用FormControlType屬性Sub Con

58、trolType() Dim MyShape As Shape For Each MyShape In Sheet1.Shapes If MyShape.Type = msoFormControl Then If MyShape.FormControlType = xlCheckBox Then MyShape.ControlFormat.Value = 1 End If End If Next Set MyShape = NothingEnd Sub范例97 使用程序代碼添加控件97-1 使用Add方法添加表單控件Sub AddButton() Dim MyButton As Button

59、On Error Resume Next Sheet1.Shapes(MyButton).Delete Set MyButton = Sheet1.Buttons.Add(60, 40, 100, 30) With MyButton .Name = MyButton .Font.Size = 12 .Font.ColorIndex = 5 .Characters.Text = 新建的按鈕 .OnAction = MyButton End With Set MyButton = NothingEnd SubSub MyButton() MsgBox 這是使用Add方法新建的按鈕!End Sub9

60、7-2 使用AddFormControl方法添加表單控件Sub AddButton() Dim MyShape As Shape On Error Resume Next Sheet1.Shapes(MyButton).Delete Set MyShape = Sheet1.Shapes.AddFormControl(0, 60, 40, 100, 30) With MyShape .Name = MyButton With .TextFrame.Characters .Font.ColorIndex = 3 .Font.Size = 12 .Text = 新建的按鈕 End With .On