Dim ITM As ListItem Dim i As Integer With ListView1
.View = lvwIcon
.Icons = ImageList1 For i = 2 To 6
Set ITM = .ListItems.Add() ITM.Text = Cells(i, 1) ITM.Icon = i - 1 Next End With
Set ITM = Nothing End Sub
Private 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 = i - 1 Next End With
Set ITM = Nothing End 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 .Buttons
.Add(1, , \ For i = 0 To UBound(arr)
.Add(i + 2, , , , i + 1).Caption = arr(i) Next End With End With End Sub
36
范例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 = Array(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 Sub
Private Sub TextBox1_Change()
StatusBar1.Panels(1).Text = \正在输入：\End Sub
范例92 使用AniGif控件显示GIF图片
Private Sub CommandButton1_Click() AniGif1.Stretch = True
AniGif1.Filename = ThisWorkbook.Path & \End Sub
范例93 使用ShockwaveFlash控件播放Flash文件
Private Sub CommandButton1_Click() With ShockwaveFlash1
.Movie = ThisWorkbook.Path & \ .EmbedMovie = False .Menu = False .ScaleMode = 2 End With End Sub
Private Sub CommandButton2_Click() ShockwaveFlash1.Play End Sub
37
Private Sub CommandButton3_Click() ShockwaveFlash1.Forward End Sub
Private Sub CommandButton4_Click() ShockwaveFlash1.Stop End Sub
Private Sub CommandButton5_Click() ShockwaveFlash1.Back End Sub
Private Sub CommandButton6_Click() ShockwaveFlash1.Movie = \End Sub
Private Sub CommandButton7_Click() Unload Me End Sub
范例94 注册自定义控件
Sub Regsvrs()
Dim SouFile As String Dim DesFile As String On Error Resume Next
SouFile = ThisWorkbook.Path & \ DesFile = \ FileCopy SouFile, DesFile
Shell \
MsgBox \控件已成功注册，现在可以使用了!\End Sub
Sub Regsvru()
Shell \End Sub
范例95 不打印工作表中的控件 范例96 遍历控件的方法
96-1 使用名称中的变量
Private Sub CommandButton1_Click() 38
Dim i As Integer For i = 1 To 3
Me.Controls(\ Next End Sub
Sub ClearText()
Dim i As Integer For i = 1 To 4
Sheet1.OLEObjects(\ Next End Sub
96-2 使用对象类型
Private Sub CommandButton1_Click() Dim Ctr As Control
For Each Ctr In Me.Controls
If TypeName(Ctr) = \ Ctr = \ End If Next
Set Ctr = Nothing End Sub
Sub ClearText()
Dim Obj As OLEObject
For Each Obj In Sheet1.OLEObjects
If TypeName(Obj.Object) = \ Obj.Object.Text = \ End If Next
Set Obj = Nothing End Sub
96-3 使用程序标识符
Sub ClearText()
Dim Obj As OLEObject
For Each Obj In Sheet1.OLEObjects
If Obj.progID = \ Obj.Object.Text = \ End If Next
Set Obj = Nothing End Sub
96-4 使用FormControlType属性
Sub ControlType()
39
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 = Nothing End Sub
范例97 使用程序代码添加控件
97-1 使用Add方法添加表单控件
Sub AddButton()
Dim MyButton As Button On Error Resume Next
Sheet1.Shapes(\
Set MyButton = Sheet1.Buttons.Add(60, 40, 100, 30) With MyButton
.Name = \ .Font.Size = 12
.Font.ColorIndex = 5
.Characters.Text = \新建的按钮\ .OnAction = \ End With
Set MyButton = Nothing End Sub
Sub MyButton()
MsgBox \这是使用Add方法新建的按钮!\End Sub
97-2 使用AddFormControl方法添加表单控件
Sub AddButton()
Dim MyShape As Shape On Error Resume Next
Sheet1.Shapes(\
Set MyShape = Sheet1.Shapes.AddFormControl(0, 60, 40, 100, 30) With MyShape
.Name = \
With .TextFrame.Characters .Font.ColorIndex = 3 .Font.Size = 12 .Text = \新建的按钮\ End With
40