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, 1).End(xlUp).Row For i = 1 To r
If Trim(.Cells(i, 1)) <> \
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 = arr End Sub
范例77 移动列表框的列表项
Private Sub CommandButton1_Click() Dim Ind As Integer 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 With End Sub
Private Sub CommandButton2_Click() Dim Ind As Integer Dim Str As String With ListBox1
Ind = .ListIndex Select Case Ind Case -1
MsgBox \请选择一行后再移动!\
26
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 With End Sub
Private Sub CommandButton3_Click() Dim i As Integer
For i = 1 To ListBox1.ListCount
Cells(i, 1) = ListBox1.List(i - 1) Next End Sub
范例78 允许多项选择的列表框
Private Sub UserForm_Initialize() Dim arr As Variant
arr = Array(\经理室\办公室\生技科\财务科\营业部\制水车间\污水厂\其他\ With Me.ListBox1 .List = arr
.MultiSelect = 1 .ListStyle = 1 End With End Sub
Private Sub 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 <> \ MsgBox Str Else
MsgBox \至少需要选择一个部门!\ End If End Sub
范例79 多列列表框的设置
Private Sub UserForm_Initialize()
27
Dim r As Integer With Sheet3
r = .Cells(.Rows.Count, 1).End(xlUp).Row - 1 End With
With ListBox1
.ColumnCount = 7
.ColumnWidths = \ .BoundColumn = 1 .ColumnHeads = True .TextAlign = 3
.RowSource = Sheet3.Range(\ End With End Sub
Private Sub ListBox1_Click() Dim r 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 With End Sub
范例80 二级组合框
Private Sub UserForm_Initialize() Dim r As Integer
Dim MyCol As New Collection Dim arr() As Variant Dim rng As Range Dim i As Integer
On Error Resume Next
r = Cells(Rows.Count, 1).End(xlUp).Row For Each rng In Range(\ 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 = Nothing End Sub
Private Sub ComboBox1_Change() Dim MyAddress As String 28
Dim rng As Range ComboBox2.Clear
With Sheet1.Range(\
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 And rng.Address <> MyAddress End If End With
ComboBox2.ListIndex = 0 Set rng = Nothing End 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 = Nothing End Sub
范例82 使用多页控件
Private Sub UserForm_Initialize() MultiPage1.Value = 0 End Sub
Private Sub MultiPage1_Change()
If MultiPage1.SelectedItem.Index > 0 Then
MsgBox \您选择的是\页面!\ End If End Sub
范例83 使用TabStrip控件
Private Sub UserForm_Initialize() TabStrip1.Value = 0 TabStrip1.Style = 0 End Sub
Private Sub TabStrip1_Change()
29
Dim str As String
Dim FilPath As String
str = TabStrip1.SelectedItem.Caption
FilPath = ThisWorkbook.Path & \ Image1.Picture = LoadPicture(FilPath) Label1.Caption = str & \欢迎您!\End Sub
范例84 在框架中使用滚动条
Private Sub UserForm_Initialize() With Frame1
.ScrollBars = 3
.ScrollHeight = Image1.Height .ScrollWidth = Image1.Width End With End 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) * .Cells(i, 2), 2) Application.Goto Reference:=.Cells(i, 1), Scroll:=True UserForm1.ProgressBar1.Value = i
UserForm1.Caption = \程序正在运行,已完成\& Format((i / r) * 100, \& \请稍候!\ Next End With
Unload UserForm1 End Sub
范例86 使用DTP控件输入日期
Private Sub Worksheet_SelectionChange(ByVal Target As Range) With Me.DTPicker1
If Target.Count = 1 And Target.Column = 1 And Not Target.Row = 1 Or Target.MergeCells
30