vba-窗体之listbox

Option Explicit

'声名模块级变量
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset

'是否变量空间、关闭数据库连接、关闭窗体
Private Sub btnClose_Click()
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
    Unload Me
End Sub

'列表框ListDept单击事件,查询部门员工
'提取员工的编号和姓名
Private Sub ListDept_Click()
    Dim sql As String
    sql = "select distinct 编号,姓名 from 员工 where 部门='" & ListDept.Value & "' order by 编号 asc"
    rst.Open sql, cnn, adOpenKeyset, adLockOptimistic
    Dim i As Integer
    
    With ListEmp
        .Clear
        For i = 1 To rst.RecordCount
            .AddItem rst("编号") & Space(2) & rst("姓名")
            rst.MoveNext
        Next
    End With
    rst.Close

End Sub

'将员工信息填入 textbox
Private Sub ListEmp_Click()
    Dim i As Integer, IDStringCut As String
    Dim arr, brr
    Dim sql As String
    
    IDStringCut = Mid(ListEmp.Value, 1, InStr(ListEmp.Value, Space(2)) - 1)
    
    sql = "select * from 员工 where 编号='" & IDStringCut & "'"
    
    rst.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
    '将每个字段的值存入空间
    
    arr = Array("txtID", "txtName", "txtAge", "txtIDcard", "txtDate", "txtAddress", _
        "txtDept", "txtJob", "txtEMail", "txtCV")
    brr = Array("编号", "姓名", "年龄", "身份证号", "聘用时间", "工作地", _
        "部门", "职务", "电子邮件", "简历")
    
    For i = 0 To UBound(arr)
        Me.Controls(arr(i)).Value = rst(brr(i))
        
    Next
    rst.Close
End Sub

'当窗体加载时，填写listDept
Private Sub UserForm_Initialize()
    
    '建立数据库连接
    Set cnn = New ADODB.Connection
    cnn_open cnn
    
    '提取不重复部门名称
    Dim sql As String
    sql = "select distinct 部门 from 员工"
    
    '执行sql语句
    Set rst = New ADODB.Recordset
    rst.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
    '将记录集中的部门显示到 listDept 列表框中
    Dim i As Integer
    With ListDept
        .Clear  '先清空再添加
        For i = 1 To rst.RecordCount
            .AddItem rst("部门")
            rst.MoveNext    '将记录集中的指针指向下一条记录
        Next
    End With
    rst.Close
   
End Sub

Sub cnn_open(cnn)
    With cnn
        .Provider = "microsoft.ace.oledb.12.0"
        .ConnectionString = "data source=" & ThisWorkbook.Path & "\学生管理.accdb"
        .Open
    End With
End Sub

 

 

转载：https://www.cnblogs.com/Stefan-Gao/p/13663641.html

 ListBox其他一些补充：

ListBox1.ListCount '列表总行数
ListBox1.MultiSelect = 1 '0或fmMultiSelectSingle不允许多项选择,1或fmMultiSelectMulti,简单的多项选择,即用鼠标单击或用空格键光标键操作,2或fmMultiSelectExtended 扩充多项选择,即用Shift键和Ctrl键配合操作,可手动在列表属性框提前设置好，或在窗体初始化时加载代码，总之要在使用前生效
ListBox1.List(i) '返回当前行的值，这是单列的，如果是多列ListBox1.List(行，列)
ListBox1.Liststyle=0 '列表风格，可多选时有效，0是标准风格，值为1时，前每项前加一个小方框，选择时打上勾。
ListBox1.ColumnCount = 6 '把列表框设为6列 好像没啥用
ControlTipText=“把鼠标移动当前控件上的时候显示的提示文字”

'反选
Private Sub CommandButton1_Click()
  If ListBox1.ListCount < 1 Then
     MsgBox "请先获取数据表字段"
     Exit Sub
  End If
  Dim i As Integer
  For i = 0 To ListBox1.ListCount - 1
  If ListBox1.Selected(i) = True Then
     ListBox1.Selected(i) = False
  Else
   ListBox1.Selected(i) = True
  End If
Next

End Sub


'全选
Private Sub CommandButton2_Click()
 Dim i As Integer
 If ListBox1.ListCount < 1 Then
    MsgBox "请先获取数据表字段"
 Exit Sub
 End If
 For i = 0 To ListBox1.ListCount - 1
    ListBox1.Selected(i) = True
 Next
End Sub

'重置
Private Sub CommandButton3_Click()
 If ListBox1.ListCount < 1 Then
   MsgBox "请先获取数据表字段"
 Exit Sub
 End If
 Dim i As Integer
 For i = 0 To ListBox1.ListCount - 1
 ListBox1.Selected(i) = False
 Next
End Sub