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