VBA ListView控件使用实例

功能:ListView控件实现连接数据库实现显示查询数据空能。

图片:

代码:

Private Sub CommandButton1_Click()
    Dim res As String
    res = TextBox1.Text
    Call UserFormabc(res)
End Sub

'ItemClick:Trigger an event when a row or ListItem is selected. To get ListItem Object which is selected.
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim intX As Integer 'Difine a variable as integer
intX = ListView1.SelectedItem.Index
TextBox1.Text = ListView1.ListItems(intX).Text
End Sub

Private Sub UserFormabc(Optional ByVal res As String = "")
With ListView1 'To initialize listview
    .ColumnHeaders.Add , , "Project No.", 120, lvwColumnLeft
    .ColumnHeaders.Add , , "Project Name", 120, lvwColumnCenter
    .ColumnHeaders.Add , , "Department", 120, lvwColumnCenter
    .ColumnHeaders.Add , , "Date", 120, lvwColumnCenter
    .View = lvwReport 'The report format
    .LabelEdit = lvwManual 'Do not edit
    .Gridlines = True
    .FullRowSelect = True
End With

    Dim cnn As String
    Dim rs As Recordset
    Dim sql As String
    cnn = "Provider=Microsoft.ACE.OLEDB.16.0;" & _
    "Data Source=D:\2\VBA\A3\database\A3db2019.accdb"
    If res = "" Then
        sql = "select A3_Project.*, A3_Dept.* from A3_Project left join A3_Dept on A3_Project.ProjectID=A3_Dept.ProjectID"
    Else
        sql = "select A3_Project.*, A3_Dept.* from A3_Project left join A3_Dept on A3_Project.ProjectID=A3_Dept.ProjectID where A3_Project.ProjectID='" & res & "'"
    End If
    Set rs = New Recordset
    rs.Open sql, cnn, 1, 1
    ListView1.ListItems.Clear
    For i = 1 To rs.RecordCount
       With ListView1.ListItems.Add()                  'Add records
            .Text = rs.Fields("A3_Project.ProjectID")   'Add the first column
            .SubItems(1) = rs.Fields("ProjectName") 'Add the second column
            .SubItems(2) = rs.Fields("Department")
            .SubItems(3) = rs.Fields("Date")
            rs.MoveNext
       End With
    Next
    rs.Close
End Sub

Private Sub UserForm_initialize()
    Call CommandButton1_Click
End Sub

猜你喜欢

转载自www.cnblogs.com/luoye00/p/10818843.html
vba
今日推荐