Microsoft Access - 表单列表框选择作为报告的数据要求

时间:2016-11-11 20:44:38

标签: vba ms-access

让我先说一下,我没有经验丰富的VB,并且一直在捣乱我的大脑来解决这个问题......我已经看到了解决方案,似乎无法将我厚厚的头骨包裹起来,因为我是这样的新手。 / p>

我有一个带表单的数据库。该表格有2个列表框" List1"和"发票类型"。每个都有独特的价值。我有一个"全选"和"清除选择"每个未绑定列表框的按钮,它们工作。

我有一个" StartDate"和" EndDate"这对于所有3个报告按钮都有效。我已经通过将它们用作查询本身的标准来完成此任务。

我的报告是" CompleteTransRPT"," NoPaymentRPT"和" PaidRPT"。每个报告都有一个按钮,除了通过列表框中所选内容的要求外,所有三个目录都在工作。

我目前的代码包括:

Private Sub Detail_Click()

End Sub

Private Sub BTNRunReport_Click()
On Error GoTo BTNRunReport_Click_Err

    DoCmd.OpenReport "CompleteTransRPT", acViewReport, "", "", acNormal


BTNRunReport_Click_Exit:
    Exit Sub

BTNRunReport_Click_Err:
    MsgBox Error$
    Resume BTNRunReport_Click_Exit

End Sub

Private Sub BTNPaidInvoices_Click()
On Error GoTo BTNPaidInvoices_Click_Err 

    DoCmd.OpenReport "PaidRPT", acViewReport, "", "", acNormal


BTNRunReport_Click_Exit:
    Exit Sub

BTNRunReport_Click_Err:
    MsgBox Error$
    Resume BTNPaidInvoices_Click_Exit

End Sub

Private Sub DeSelectAllTeams_Click()

    Dim varItm As Variant

    With TeamName

        For Each varItm In .ItemsSelected
            .Selected(varItm) = False
        Next varItm

    End With
End Sub

Private Sub SelectAllTeams_Click()

Dim i As Integer

For i = 0 To Forms!InvoiceReporting!TeamName.ListCount - 1
Forms!InvoiceReporting!TeamName.Selected(i) = True
Next i

End Sub 

Private Sub SelectAllInvoices_Click()

Dim i As Integer

For i = 0 To Forms!InvoiceReporting!InvoiceType.ListCount - 1
Forms!InvoiceReporting!InvoiceType.Selected(i) = True
Next i

End Sub

Private Sub DeSelectAllInvoices_Click()

    Dim varItm As Variant

    With InvoiceType

        For Each varItm In .ItemsSelected
            .Selected(varItm) = False
        Next varItm

    End With
End Sub

如何使用两个列表框中的选定字段作为报告中显示内容的要求? 编辑:这里要求的是报告查询

SELECT Almost.[Invoice #], Almost.[Invoice Date], Almost.[Invoice Amount], 
    Almost.Payment, Almost.Expression AS Due, Almost.[Invoice Type], 
    Almost.[Invoice Comments], Almost.[Team Name]
FROM Almost
WHERE (((Almost.[Invoice Date]) Between [Forms]![INVOICEREPORTING]![txtBeginDate] 
                                    And [Forms]![INVOICEREPORTING]![txtEndDate])); 

结束于:

Option Compare Database

Private Sub Detail_Click()

End Sub



Private Sub BTNRunReport_Click()
On Error GoTo BTNRunReport_Click_Err
    'DoCmd.OpenReport "CompleteTransRPT", acViewReport, , strFilter
    Dim strFilter As String
    Dim lSelCnt As Long
    strFilter = ""

    strWhere = GetValues(Me.TeamName, "Team Name", lSelCnt)
    If lSelCnt >= 1 Then strFilter = strFilter & "(" & strWhere & ")"

    lSelCnt = 0
    strWhere = GetValues(Me.InvoiceType, "Invoice Type", lSelCnt)
    If lSelCnt >= 1 Then
        If Len(strFilter) > 0 Then
            strFilter = strFilter & " AND (" & strWhere & ")"
        Else
            strFilter = strFilter & " (" & strWhere & ")"
        End If
    End If


    Debug.Print strFilter

    DoCmd.OpenReport "CompleteTransRPT", acViewReport, , strFilter

BTNRunReport_Click_Exit:
    Exit Sub

BTNRunReport_Click_Err:
    MsgBox Error$
    Resume BTNRunReport_Click_Exit

End Sub

Private Sub BTNPaidInvoices_Click()
On Error GoTo BTNPaidInvoices_Click_Err
 'DoCmd.OpenReport "PaidRPT", acViewReport, , strFilter
    Dim strFilter As String
    Dim lSelCnt As Long
    strFilter = ""

    strWhere = GetValues(Me.TeamName, "Team Name", lSelCnt)
    If lSelCnt >= 1 Then strFilter = strFilter & "(" & strWhere & ")"

    lSelCnt = 0
    strWhere = GetValues(Me.InvoiceType, "Invoice Type", lSelCnt)
    If lSelCnt >= 1 Then
        If Len(strFilter) > 0 Then
            strFilter = strFilter & " AND (" & strWhere & ")"
        Else
            strFilter = strFilter & " (" & strWhere & ")"
        End If
    End If


    Debug.Print strFilter

    DoCmd.OpenReport "PaidRPT", acViewReport, , strFilter

BTNPaidInvoices_Click_Exit:
    Exit Sub

BTNPaidInvoices_Click_Err:
    MsgBox Error$
    Resume BTNPaidInvoices_Click_Exit


End Sub

Private Sub BTNUnPaidInvoices_Click()
On Error GoTo BTNUnPaidInvoices_Click_Err

    'DoCmd.OpenReport "CompleteTransRPT", acViewReport, , strFilter
    Dim strFilter As String
    Dim lSelCnt As Long
    strFilter = ""

    strWhere = GetValues(Me.TeamName, "Team Name", lSelCnt)
    If lSelCnt >= 1 Then strFilter = strFilter & "(" & strWhere & ")"

    lSelCnt = 0
    strWhere = GetValues(Me.InvoiceType, "Invoice Type", lSelCnt)
    If lSelCnt >= 1 Then
        If Len(strFilter) > 0 Then
            strFilter = strFilter & " AND (" & strWhere & ")"
        Else
            strFilter = strFilter & " (" & strWhere & ")"
        End If
    End If


    Debug.Print strFilter

    DoCmd.OpenReport "NoPaymentRPT", acViewReport, , strFilter

    'DoCmd.OpenReport "NoPaymentRPT", acViewReport, "", "", acNormal


BTNUnPaidInvoices_Click_Exit:
    Exit Sub

BTNUnPaidInvoices_Click_Err:
    MsgBox Error$
    Resume BTNUnPaidInvoices_Click_Exit

End Sub

Private Sub DeSelectAllTeams_Click()

    Dim varItm As Variant

    With TeamName

        For Each varItm In .ItemsSelected
            .Selected(varItm) = False
        Next varItm

    End With
End Sub

Private Sub SelectAllTeams_Click()

Dim i As Integer

For i = 0 To Forms!INVOICEREPORTING!TeamName.ListCount - 1
Forms!INVOICEREPORTING!TeamName.Selected(i) = True
Next i

End Sub

Private Sub SelectAllInvoices_Click()

Dim i As Integer

For i = 0 To Forms!INVOICEREPORTING!InvoiceType.ListCount - 1
Forms!INVOICEREPORTING!InvoiceType.Selected(i) = True
Next i

End Sub

Private Sub DeSelectAllInvoices_Click()

    Dim varItm As Variant

    With InvoiceType

        For Each varItm In .ItemsSelected
            .Selected(varItm) = False
        Next varItm

    End With
End Sub


Function GetValues(lstbox As ListBox, lstField As String, lSelectedCnt As Long) As String

    Dim varItem As Variant      'Selected items
    Dim strWhere As String      'String to use as WhereCondition
    Dim strDescrip As String    'Description of WhereCondition
    Dim lngLen As Long          'Length of string
    Dim strDelim As String      'Delimiter for this field type.

    'strDelim = """"

    'Loop through the ItemsSelected in the list box.
    With lstbox
        For Each varItem In .ItemsSelected
            If Not IsNull(varItem) Then
                'Build up the filter from the bound column (hidden).
                strWhere = strWhere & "'" & strDelim & .ItemData(varItem) & strDelim & "',"
                lSelectedCnt = lSelectedCnt + 1
            End If
        Next
    End With

    'Remove trailing comma. Add field name, IN operator, and brackets.
    lngLen = Len(strWhere) - 1
    If lngLen > 0 Then
        GetValues = "[" & lstField & "] IN (" & Left$(strWhere, lngLen) & ")"
    End If

End Function

它有效,但如果有人发现任何问题,请告诉我。我将离开之前和之后希望它可以在将来帮助其他人...我基本上使用其他人的代码并通过将各种帖子放在不同的网站上来工作直到它工作。

1 个答案:

答案 0 :(得分:0)

使用多选列表框,这需要一些代码。

您需要为列表框中的[发票类型]构建动态过滤器,然后使用此过滤器打开报告。

所以你想要的是例如。

' if Invoice Types are ID numbers:
strFilter = "[Invoice Type] IN (4, 15, 77)"
' or if Invoice Types are text:
strFilter = "[Invoice Type] IN ('xx', 'yy', 'zz')"

DoCmd.OpenReport "CompleteTransRPT", acViewReport, "", strFilter, acNormal

如何获得strFilter
通过连接所有列表框.ItemsSelected值,请参阅:

MS Access - Multi Select Listbox to delete records from table

https://stackoverflow.com/a/6075399/3820271