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