【Access示例】加载ListView控件的通用函数

时　间:2014-03-23 08:21:43
作　者:缪炜   ID：24010  城市：江阴
摘　要:加载ListView控件的通用函数
正　文:

ListView我个人认为并没有我们平时用的数据表窗体之类的实用，但有些情况下需要用到他，这里给大家一个用来加载ListVie控件的通用函数

'============================================
'函数名称： BuildLVW
'功能描述： 加载ListView控件
'使用示例： 例：BuildLVW "tbdata", Me.ListView1.Object
'============================================

Public Function BuildLVW(sTable As String, oListView As ListView)

    On Error GoTo Err_Handler
    Dim chColHead As ColumnHeader
    Dim itmNewLine As ListItem
    Dim intIndex As Integer
    Dim intCount2 As Integer
    Dim intTotCount As Integer
    Dim rsListView As DAO.Recordset
    Set rsListView = CurrentDb.OpenRecordset("Select * From " & sTable & " ", dbReadOnly)
    rsListView.MoveFirst
    rsListView.MoveLast

    With rsListView
        '清除....
        oListView.ColumnHeaders.Clear
        oListView.ListItems.Clear
        rsListView.MoveFirst
        For intIndex = 0 To .Fields.Count - 1
            Set chColHead = oListView.ColumnHeaders.Add(, , rsListView(intIndex).Name) '加标题
            oListView.ColumnHeaders.Item(intIndex + 1).Width = 2000    '调整尺寸...
        Next intIndex

        If .EOF = False Then
            intTotCount = rsListView.RecordCount
            For intIndex = 1 To intTotCount
                If IsNull(rsListView(0).Value) = False Then '加入第一列数据
                    If IsNumeric(rsListView(0).Value) Then
                        Set itmNewLine = oListView.ListItems.Add(, , Str(rsListView(0).Value))
                    Else
                        Set itmNewLine = oListView.ListItems.Add(, , rsListView(0).Value)
                    End If
                 
                    For intCount2 = 1 To .Fields.Count - 1
                        If IsNull(rsListView(intCount2).Value) = False Then
                            itmNewLine.SubItems(intCount2) = rsListView(intCount2).Value
                        Else
                            itmNewLine.SubItems(intCount2) = ""
                        End If
                    Next intCount2
                    .MoveNext
                Else
                    Set itmNewLine = oListView.ListItems.Add(, , "")
                End If
            Next intIndex
            oListView.GridLines = True
        Else
            oListView.ListItems.Clear
            oListView.GridLines = False
        End If
    End With
ExitHere:
    Set rsListView = Nothing
    Exit Function
Err_Handler:

    MsgBox Err.Description, vbCritical
    Resume ExitHere
End Function

附   件:

点击附件下载