FILTRI X DATE

Question

Buongiorno a tutti,

grazie all'aiuto ricevuto sono riuscito all'interno di una maschera del mio database a creare dei filtri multipli, per l'esattezza 4 filtri su altrettanti campi.

Nella stessa maschera vorrei ora inserire anche dei filtri sulle date, ovvero inserire dei filtri che mi limitano la ricerca tra due date e, avendo più colonne che riportano una data, vorrei che questi filtri potessero essere estesi a tutti i campi dove vengono riportate delle date.

Un esempio forse spiega meglio quello che voglio fare.

la mia maschera (maschera continua), prende i dati da una query che, tra i vari campi dove già vengono applicati dei filtri (quattro), c'è una campo "DATA FATTURA"; un campo "DATA SCADENZA" e un campo "DATA PAGAMENTO", vorrei inserire dei filtri (due) per ogni campo che mi permetta di filtrare i record per limiti di data su uno, due o anche tutti e tre campi.

Riguardo ai filtri già realizzati, per ognuno di questi ho utilizzato il seguente codice:

Private Sub cboDENOMINAZIONE_AfterUpdate()

    On Error Resume Next

    ApplicaFiltri

End Sub

di questi ovviamente ne ho inseriti uno per ogni _AfterUpdate che intendo filtrare, poi ho creato questo codice:

Private Sub ApplicaFiltri()

    Dim wFiltro As String

    On Error Resume Next

    wFiltro = ""

    If Left(Me.cboDENOMINAZIONE, 1) <> "(" Then

       wFiltro = wFiltro & " And NOMINATIVO = '" & Me.cboDENOMINAZIONE & "' "

    End If

    If Len(Me.cboBANCA & "") > 0 Then

       wFiltro = wFiltro & " And Banca = '" & Me.cboBANCA & "' "

    End If

    If Len(Me.cboTIPOLOGIA & "") > 0 Then

       wFiltro = wFiltro & " And Tipo = '" & Me.cboTIPOLOGIA & "' "

    End If

    If Len(Me.cboSTATO & "") > 0 Then

       wFiltro = wFiltro & " And Stato = '" & Me.cboSTATO & "' "

    End If

    Me.Filter = Mid(wFiltro, 6, Len(wFiltro))

    Me.FilterOn = True

End Sub

fin qui tutto bene, ovvero funziona tutto perfettamente, successivamente ho creato i primi due campi da utilizzare come filtri data sul campo "DATA FATTURA" (DATAFT) e aggiunto un pulsante dove al click ho applicato il seguente codice:

Private Sub BINOCOLO_Click()

    On Error Resume Next

    If IsNull(Me.DATAFT1.Value) Or IsNull(Me.DATAFT2.Value) Then GoTo A

    Me.Filter = "[DATAFT] >= #" & Format(DATAFT1, "mm/dd/yyyy") & "# And [DATAFT] <= #" & Format(DATAFT2, "mm/dd/yyyy") & "#"

    Me.FilterOn = True

A:

End Sub

anche questo filtro funziona ma... e qui nasce il problema, se ho già filtrato il database con i filtri precedenti, questo nuovo filtro mi annulla quello precedente.

devo quindi continuare ad utilizzare il filtro, o meglio i filtri "DATA" all'interno della stessa routine "ApplicaFiltri".

Qualcuno sa dirmi come fare?

Grazie come sempre della preziosa collaborazione

Ciro

Answer 1

ciao Ciro,

ho optato per un gruppo opzioni in cui scegliere la data a cui applicare il filtro :

questa la routine VBA rivista :

Private Sub ApplicaFiltri()

    'Dim wFiltro As String

    'On Error Resume Next

    'wFiltro = ""

    'If Left(Me.cboDENOMINAZIONE, 1) <> "(" Then

    '   wFiltro = wFiltro & " And NOMINATIVO = '" & Me.cboDENOMINAZIONE & "' "

    'End If

    'If Len(Me.cboBANCA & "") > 0 Then

    '   wFiltro = wFiltro & " And Banca = '" & Me.cboBANCA & "' "

    'End If

    'If Len(Me.cboTIPOLOGIA & "") > 0 Then

    '   wFiltro = wFiltro & " And Tipo = '" & Me.cboTIPOLOGIA & "' "

    'End If

    'If Len(Me.cboSTATO & "") > 0 Then

    '   wFiltro = wFiltro & " And Stato = '" & Me.cboSTATO & "' "

    'End If

    'Me.Filter = Mid(wFiltro, 6, Len(wFiltro))

    'Me.FilterOn = True

On Error GoTo errHandler

Dim strFilter     As String

Dim strFilterDate As String

With Me

    If Len(.cboDENOMINAZIONE & vbNullString) > 0 And .cboDENOMINAZIONE <> "(TUTTO)" Then strFilter = strFilter & "nominativo='" & .cboDENOMINAZIONE & "' and "

    If Len(.cboBANCA & vbNullString) > 0 Then strFilter = strFilter & "BANCA='" & .cboBANCA & "' and "

    If Len(.cboTIPOLOGIA & vbNullString) > 0 Then strFilter = strFilter & "Tipo='" & .cboTIPOLOGIA & "' and "

    If Len(.cboSTATO & vbNullString) > 0 Then strFilter = strFilter & "Stato='" & .cboSTATO & "' and "

    If Len(strFilter) > 0 Then

            If Len(.txtDaData & vbNullString) = 0 Then .txtDaData = #1/1/1900#

            If Len(.txtAdata & vbNullString) = 0 Then .txtAdata = #12/31/2100#

            Select Case .grpData

                Case 1

                    strFilterDate = "dataft>=" & CLng(.txtDaData) & " and dataft<" & CLng(.txtAdata) + 1

                Case 2

                    strFilterDate = "dataSC>=" & CLng(.txtDaData) & " and dataSC<" & CLng(.txtAdata) + 1

                Case 3

                    strFilterDate = "dataPG>=" & CLng(.txtDaData) & " and dataPG<" & CLng(.txtAdata) + 1

            End Select

            .Filter = Left$(strFilter, Len(strFilter) - 5) & " and " & strFilterDate

            .FilterOn = True

        Else

            .Filter = vbNullString

            .FilterOn = False

        End If

End With

exit_here:

    Exit Sub

errHandler:

    With Err

        VBA.MsgBox "ERR#" & .Number _

            & vbNewLine & .Description _

            , vbOKOnly Or vbCritical

    End With

    Resume exit_here

End Sub

QUI trovi il tuo DB con le suddette modifiche, fai qualche test e facci sapere.

Ciao, Sandro.

Answer 2

ciao Ciro, 

grazie, e se puoi ti invito a contrassegnare la risposta come risposta predefinita, chiudiamo il post ed aiuterai altri che come te potrebbero incappare nello stesso quesito.

Grazie ancora e buona serata.

Ciao, Sandro.

Answer 3

Grazie Sandro

ho fatto diverse prove e... devo dire che il tuo codice è perfetto, ovvero interpreta perfettamente le mie esigenze.

Grazie ancora, sei un grande

AS presto

Ciro