Listview + ToolBar 控件学习笔记

一指禅62

Listview + Toolbar 控件学习笔记.zip (59.55 KB, 下载次数: 760)

2014-3-5 15:02 上传

点击文件名下载附件

补充内容 (2014-8-6 17:26):



增加了调整 ListView 行高的语句，在14楼

一指禅62

窗体初始化代码

1. Private Sub UserForm_Initialize()
   
2.     With Toolbar1
   
3.         .Style = tbrFlat            '设置工具栏样式
   
4.         .ImageList = ImageList1     '绑定图标来源到listview1
   
5.         .Buttons.Add Style:=3       '添加一个占位按钮
   
6.         .Buttons.Add Style:=3
   
7.         .Buttons.Add Caption:="增加单据", Style:=0, Image:=1    '添加按钮并设置其标题,样式,图标
   
8.         .Buttons.Add Caption:="保存单据", Style:=0, Image:=2
   
9.         .Buttons.Add Caption:="查询单据", Style:=5, Image:=3
   
10.         .Buttons.Add Caption:="打印单据", Style:=0, Image:=4
    
11.         .Buttons.Add Caption:="撤消", Style:=0, Image:=5
    
12.         .Buttons.Add Style:=0
    
13.         .Buttons(8).Enabled = False
    
14.         .Buttons.Add Caption:="退出", Style:=0, Image:=6
    
15.         .Buttons.Add Style:=3
    
16.         .Buttons.Add Style:=3
    
17.     End With
    
18.     Dim d As Object
    
19.     Set d = CreateObject("Scripting.Dictionary")
    
20.     arr = Sheet1.UsedRange
    
21.     With ListView1      'Listview1初始化
    
22.         .ColumnHeaders.Add , , "行号"
    
23.         For i = 1 To UBound(arr, 2)
    
24.             .ColumnHeaders.Add , , arr(1, i)
    
25.         Next
    
26.         .FullRowSelect = True
    
27.         .Gridlines = True
    
28.         .LabelEdit = lvwManual
    
29.         .View = lvwReport
    
30.     End With
    
31.     For i = 2 To UBound(arr)    '为“查询单据”按钮添加菜单
    
32.         If Not d.Exists(arr(i, 1)) Then
    
33.             d(arr(i, 1)) = ""
    
34.             Toolbar1.Buttons(5).ButtonMenus.Add = arr(i, 1)
    
35.         End If
    
36.     Next
    
37. End Sub

复制代码

一指禅62

删除选中记录代码

1. Private Sub ListView1_DblClick()
   
2.     If iRow < 2 Then Exit Sub
   
3.     If MsgBox("特别提示：数据删除后不可恢复！" + Chr(10) + Chr(10) + _
   
4.         "真要删除这条记录吗？", vbQuestion + vbOKCancel) = vbOK Then
   
5.         ListView1.ListItems.Remove ListView1.SelectedItem.Index
   
6.         Sheet1.Rows(iRow & ":" & iRow).Delete Shift:=xlUp
   
7.         iRow = 0
   
8.     End If
   
9. End Sub

复制代码

一指禅62

添加一条记录（修改选中记录）代码

1. Private Sub CmdOK_Click()
   
2.     Dim brr(1 To 3), k As Integer
   
3.     Dim Saveft As Boolean
   
4.     Saveft = True
   
5.     For i = 1 To 3
   
6.         With Me.Controls("Text" & i)
   
7.             If .Text = "" Then
   
8.                 'MsgBox "数据不全。请补充完整和重新保存", vbInformation
   
9.                 .SetFocus
   
10.                 Saveft = False
    
11.                 Exit For
    
12.             Else
    
13.                 brr(i) = Trim(.Text)
    
14.             End If
    
15.         End With
    
16.     Next
    
17.     If Saveft = False Then Exit Sub '数据不全，不保存
    
18.     If CmdOK.Caption = "修改" Then
    
19.         If iRow = 0 Then Exit Sub
    
20.         Sheet1.Range("A" & iRow).Resize(1, 3) = brr
    
21.         Call ListView
    
22.         iRow = 0
    
23.     ElseIf CmdOK.Caption = "确定" Then
    
24.         With ListView1
    
25.             k = .ListItems.Count + 1
    
26.             .ListItems.Add , , k
    
27.             For i = 1 To UBound(brr)
    
28.                 .ListItems(k).SubItems(i) = brr(i)
    
29.             Next
    
30.         End With
    
31.         If WorksheetFunction.CountIf(Sheet1.Range("A:A"), Trim(Text1)) = 0 Then
    
32.             Toolbar1.Buttons(5).ButtonMenus.Add , , Trim(Text1)
    
33.         End If
    
34.         Text2 = "": Text3 = "": Text1.SetFocus
    
35.     End If
    
36. End Sub

复制代码

一指禅62

模糊查询代码

1. Private Sub txtFind_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
   
2.     If KeyCode = 13 Then Call CmdFind_Click: txtFind.SetFocus
   
3. End Sub
   
4. 
   
5. Private Sub CmdFind_Click() '模糊查询
   
6.     Dim k As Integer
   
7.     With ListView1
   
8.         If CmdOK.Caption = "确定" And .ListItems.Count > 0 Then
   
9.             If MsgBox("当前记录需要保存吗？", vbQuestion + vbYesNo) = vbYes Then
   
10.                 Call SaveView
    
11.             End If
    
12.         End If
    
13.         arr = Sheet1.UsedRange
    
14.         .ListItems.Clear
    
15.         For i = 2 To UBound(arr)
    
16.             If arr(i, 1) Like "*" & Trim(txtFind) & "*" Then
    
17.                 k = k + 1
    
18.                 .ListItems.Add , , k
    
19.                 For j = 1 To UBound(arr, 2)
    
20.                     .ListItems(k).SubItems(j) = arr(i, j)
    
21.                 Next
    
22.             End If
    
23.         Next
    
24.     End With
    
25.     CmdOK.Caption = "修改"
    
26.     With Toolbar1
    
27.         .Buttons(3).Enabled = False
    
28.         .Buttons(4).Enabled = False
    
29.     End With
    
30. End Sub

复制代码

lcjy11185

做个几号，非常好用。

fox_9741

可以增加Checkbox，然后做成批量删除。

乱舞天下

请问 运行后显示
“无法装载这些对象，因为他们不适用于这台计算机”
Toolbar1  “编译错误 未定义变量”
如何解决？
计算机系统：win8.1版本
excel2013版本
详见附件

一指禅62

乱舞天下 发表于 2014-3-8 11:29
请问 运行后显示
“无法装载这些对象，因为他们不适用于这台计算机”
Toolbar1  “编译错误 未定义变量” ...

ToolBar 是非标准控件。关于非标准控件的问题在坛子里搜吧。

一指禅62

到这里看看吧，或许对你有帮助

http://club.excelhome.net/thread-425193-3-1.html