第6章--控件与用户窗体代码

1、精选优质文档倾情为你奉上精选优质文档倾情为你奉上专心专注专业专心专注专业精选优质文档倾情为你奉上专心专注专业第6章 控件与用户窗体范例67 文本框只能输入数值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 验证文本框输入的数据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 身份证号码错误，请重新输入! 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 = 文本框是一个灵活的控件，受下列属性的影响：Text、 _ & MultiLine、WordWrap和AutoSize。 & vbCrLf _ & Text 包含显示在文本框中的文本。 & vbCrLf _ & MultiLine 控制文本框是单行还是多行显示文本。 _ & 换行字符用于标识在何处结束一行并开始新的一行。 _ & 如果 MultiLine 的值为False，则文

6、本将被截断， _ & 而不会换行。如果文本的长度大于文本框的宽度， _ & WordWrap允许文本框根据其宽度自动换行。 & vbCrLf _ & 如果不使用 WordWrap，当文本框在文本中遇到换行字符时， _ & 开始一个新行。如果关闭WordWrap，TextBox中可以有不能 _ & 完全适合其宽度的文本行。文本框根据该宽度，显示宽度以 _ & 内的文本部分，截断宽度以外的那文本部分。只有当 _ & MultiLine为True时，WordWrap才起作用。 & vbCrLf _ & AutoSize 控制是否调节文本框的大小，以便显示所有文本。 _ & 当文本框使用AutoSiz

7、e 时，文本框的宽度按照文本框中的 _ & 文字量以及显示该文本的字体大小收缩或扩大。 End WithEnd Sub范例72 格式化文本框数据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、可视区域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 列表框添加列表项的方法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 去除列表项的空行和重复项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 移动列表框的列表项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 已经是第一行了! 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 已经是最后下一行了! 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 允许多项选择的列表框Private Sub UserForm_Initialize() Dim arr As Variant arr = Array(经理室, 办公室, 生技科, 财务科, 营业部, 制水车间, 污水厂, 其他) 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 至少需要选择一个部门! End IfEnd Sub范例79 多列列表框的设置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控件选择区域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 制作进度条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 = 程序正在运行,已完成 & 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控件显示数据列表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 , , 应发合计, 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控件中使用复选框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 , , 应发合计, 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 调整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 , , 应发合计, 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控件的图标设置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( 录入 , 审核, 记账 , 结账 , 负债表, 损益表) 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控件添加状态栏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 = 准备就绪!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控件已成功注册，现在可以使用了!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 使用程序标识符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