格式化列表框替代

时间:2018-04-03 09:32:07

标签: ms-access access-vba ms-access-2010

我需要格式化我的列表框 - 所以演示我的列表框正确地提取我的数据我有这个代码有效:

解: 我设法让控件工作,而不是我需要它,但它现在显示数据。我不得不更改现在设置为的SQL:

strSQL = "SELECT [_tbl_Structure].[User Name], Sum(tbl_RTI.[Credit]) AS SumOfCredit, Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name];"

代码:

Stats.RowSource = "SELECT [_tbl_Structure].[User Name], Sum(CCur([Credit])) AS [Total Credit], Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name], [_tbl_Structure].[Supervisor ID] HAVING ((([_tbl_Structure].[Supervisor ID])=[Forms]![frm_Managers_Stats_TeamView_Daily]![EI]));"

现在我需要将它实现到Microsoft Listview控件中 - 我有以下代码但控件中没有显示任何内容:

代码:

On Error GoTo err_handle
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Variables
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Dim lvxObj As ListView
    Dim lstItem As ListItem
    Dim rs As DAO.Recordset
    Dim fld As DAO.Field
    Dim iColWidth As Integer
    Dim i As Integer
    Dim strSQL As String

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Set the SQL statement for our recordsource
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'By using the SQL 'AS' keyword, we can give our columns custom names...

        strSQL = "SELECT [_tbl_Structure].[User Name], Sum(CCur([Credit])) AS [Total Credit], Count(tbl_RTI.Credit) AS Volume FROM _tbl_Structure INNER JOIN tbl_RTI ON [_tbl_Structure].[User ID] = tbl_RTI.CDP GROUP BY [_tbl_Structure].[User Name], [_tbl_Structure].[Supervisor ID] HAVING ((([_tbl_Structure].[Supervisor ID])=[Forms]![frm_Managers_Stats_TeamView_Daily]![EI]));"

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Set up List View object, and invoke a recordset based on the SQL
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Set lvxObj = lvxEmployees.Object
        Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'  Clear any items in the current list.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        lvxObj.ListItems.Clear

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Clear existing, then add new column headers
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

'code loops through the open recordset's field names (the custom
'ones with set using the AS keyword, if you remember) and sets them
'as our ListViews columnheaders.
'We also set the column widths to be all the same, which is calculated
'by taking the width of the ListView itself, divided by the number of
'columns.  I minus 20 of the end of each one, to ensure all fields are
'visible completely (not hanging over the edge of the listview).


            With lvxObj.ColumnHeaders
            .Clear
                For i = 0 To rs.Fields.Count
                    For Each fld In rs.Fields
                        If i = 0 Then
                         iColWidth = 0 ' This hides the first ID column from the user, but retains it's value as the identifying property
                        Else
                         iColWidth = (lvxEmployees.Width / (rs.Fields.Count - 1)) - 20
                        End If
                     .Add , , fld.Name, iColWidth
                     i = i + 1
                    Next fld
                Next i
            End With

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Check values present in recordset
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If rs.BOF Then
        'No data has been returned .. no need to add the items to the
    ' list view.
    Else
        'Records present.. setting up list of items

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Add in list items, with colour based on criteria of if the
' employee is active or not.
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        rs.MoveFirst

        While Not rs.EOF
            For i = 0 To rs.Fields.Count
                If i = 0 Then
                    Set lstItem = lvxObj.ListItems.Add(, , Nz(Trim(rs(i)), "")) ' Set the value of the first column of the row

            'Set the Colour based on criteria
            If rs("Total Credit") >= 0 Then
             lstItem.ForeColor = vbBlack ' Black if not active
            Else
             lstItem.ForeColor = vbRed ' Red if active
            End If
                ElseIf i < rs.Fields.Count Then
                    lstItem.SubItems(i) = Nz(Trim(rs(i)), "") ' set the subsequent columns, known as subitems.

             'Repeat Colour setting based on criteria, for the subitems
            If rs("Total Credit") >= 65 Then
             lstItem.ForeColor = vbBlack ' Black if not active
            Else
             lstItem.ForeColor = vbRed ' Red if active
            End If
                Else
                End If
            Next i
            rs.MoveNext
        Wend
    End If


'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' Close off & Cleanup
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    rs.Close

err_handle:
    Select Case Err.Number
        Case 0
         'ignore, not an Error
        Case Else
     'Handle error Appropriately.
    End Select

从查看上面的代码是否有任何跳出来我可能遗漏的东西?

错误:

  

参数很少。预计1

0 个答案:

没有答案