Filtern eines Formulars mit Datumsvergleich in VBA

[Umbauwfb]

Vielen Dank für die Hilfe und die Codes...
Das ist sehr hilfreich!

Ich habe alles schon eingebaut und werde jetzt erst einmal ausgiebig testen und mich in die angegebenen Informationen einarbeiten.
Melde mich dann!

Harry

[Umbauwfb]

Das Cluster "Aufgaben und Aufgaben Filtern" ist für den Moment erfolgreich abgeschlossen.
Ich werde noch "Gruppen/Klassen" hinzufügen...das ist aber dann kein Problem mehr.

Prinzipiell arbeite ich bewusst mit 2 sich ergänzenden Filtermethoden:

- Filtern über Abfrage und Filterfeld im Formular (insbesondere wegen der 3-stufigen Auswahlmöglichkeit mit der CheckBox bei "Fertig")

- Filtern mit VBA, Optionsgruppe und Me.Filter = ....

Ich freue mich sehr über das erzielte Ergebnis.
Vielen Dank für Eure Mithilfe!

Harry

Das Cluster aus der Access-Datenbank hängt an
Ein Screenshot des Formulars hängt an

Der Code sieht aus wie folgt:

Code [Auswählen] Erweitern

Option Compare Database
Option Explicit

'**************Verändern [DatumFertigSOLL] über Zeit-Buttons**********************

Private Sub cmdDayMinus1_Click()
    Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value - 1
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
End Sub

Private Sub cmdDayPlus1_Click()
    Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value + 1
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
End Sub

Private Sub cmdHourMinus1_Click()
    Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value - (1 / 24)
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
    End Sub

Private Sub cmdHourPlus1_Click()
    Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value + (1 / 24)
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
End Sub

Private Sub cmdMinuteMinus15_Click()
Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value - (1 / 24 / 60 * 15)
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
End Sub

Private Sub cmdMinutePlus15_Click()
Dim sql As String
    sql = Forms!TaskF!DatumFertigSoll.Value + (1 / 24 / 60 * 15)
    Forms!TaskF!DatumFertigSoll.Value = sql
    Me.DatumFertigSoll.SetFocus
End Sub






'***************Filtern in TaskF mit Abfrage und VBA(Filter)***********

'++++++Abfrage:
'Beim Öffnen des Formulars:
'RecordSource ist TaskQ (hat KEINE Filter)
'Die Filterfelder txtFilterFirma, txtFilterTeilnehmer und cboFilterPrioritaet
'werden auf "" gesetzt

'Bei Einträgen in txtFilterFirma, txtFilterTeilnehmer und cboFilterPrioritaet
'wird mit _AfterUpdate() die RecordSource gewechselt zu TaskFilterQ
'Damit ist eine saubere Ausgangsposition für neue Filterauswahlen gesetzt
'Sobald der Eintrag in einem der Filterfelder
'txtFilterFirma, txtFilterTeilnehmer, cboFilterPrioritaet
'mit Enter abgeschlossen wird, wird in die RecordSource TaskFilterQ gewechselt
'und dort entsprechend weiter gefiltert


'Inhalte der Filterfelder im Formular werden auf "" gesetzt mit
'oleFilterKomplettLoeschen (wechselt in die filterlose RecordSource TaskQ)
'oleFilterFirmaLoeschen
'oleFilterTeilnehmerLoeschen


'Mit dem dreistufigen Check-Button chkFilterFertig werden
'- Alle Aufgaben
'- nur die erledigten Aufgaben
'- nur die offenen Aufgaben
'gefiltert
'(in der Spalte "Fertig" der Abfrage TaskFilterQ)



'++++++VBA-Filter (Me.Filter =....):
'mit Optionsgruppe ogrTermineBis mit den 6 Optionen
'Case 1      ALLE anzeigen
'Case 2      Alle Termine bis einschließlich Heute
'Case 3      Alle Termine bis einschließlich Morgen
'Case 4      Alle Termine bis Ende der aktuellen Woche
'Case 5      Alle Termine bis Ende der aktueller Monat
'Case 6      Alle Termine bis eingegebenem Datum in Feld: Forms!TaskF!txtDatumBis
'ergänzend zu Case 6: Nach Eintrag in Feld [txtDaumBis] wird
'die Optionsgruppe ogrTermineBis auf NULL gesetzt.
'Mit der erneuten Auswahl von Case 6 wird dann gefiltert







'***************Formular TaskF öffnen***********

Private Sub Form_Load()
    Me.RecordSource = "TaskQ"
    Me.txtFilterFirma = ""
    Me.txtFilterTeilnehmer = ""
    Forms!TaskF.cboFilterPrioritaet = ""
End Sub




'***************Filter in Formular TaskF KOMPLETT löschen***********
'Wechsel der RecordSource von "TaskFilterQ, die ALLE Filter hat
'auf "TaskQ", die keine Filter hat
'(eine Kopie von TaskFilterQ ohne Filter in der Abfrage)

Private Sub oleFilterKomplettLoeschen_Click()
    Me.RecordSource = "TaskQ"
    Me.txtFilterFirma = ""
    Me.txtFilterTeilnehmer = ""
    Forms!TaskF.cboFilterPrioritaet = ""
    ogrTermineBis = 1
    Me.Requery
End Sub

Private Sub oleFilterFirmaLoeschen_Click()
    Me.txtFilterFirma = ""
    Me.Requery
End Sub

Private Sub oleFilterPrioLoeschen_Click()
    Forms!TaskF.cboFilterPrioritaet = ""
    Me.Requery
End Sub

Private Sub oleFilterTeilnehmerLoeschen_Click()
    Me.txtFilterTeilnehmer = ""
    Me.Requery
End Sub





'***************DetailFormular Aufgaben***********

Private Sub Task_DblClick(Cancel As Integer)
    DoCmd.OpenForm "TaskDetailF", , , "TaskID =" & TaskID
End Sub






'***************Wechsel RecordSource nach Aktualisierung Filtereingabe ***********
'Wechsel von RecordSource "TaskQ", die keine Filter in der Abfrage hat
'zu RecordSource "TaskFilterQ", die ALLE Filter in der Abfrage hat

Private Sub txtFilterFirma_AfterUpdate()
    Me.RecordSource = "TaskFilterQ"
    Me.Requery
End Sub

Private Sub txtFilterTeilnehmer_AfterUpdate()
    Me.RecordSource = "TaskFilterQ"
    Me.Requery
End Sub

Private Sub cboFilterPrioritaet_AfterUpdate()
    Me.RecordSource = "TaskFilterQ"
    Me.Requery
End Sub

Private Sub chkFilterFertig_AfterUpdate()
    Me.RecordSource = "TaskFilterQ"
    Me.Requery
End Sub


'***************************************************
'Der Check-Button ist in der Tabelle TaskT als
'(Zur Info: Für  Options-Buttons gilt dasselbe)

' Ja/Nein-Feld angelegt mit dem Format (Tabelle unten)
' Ein/Aus
'Im Formular / Eigenschaften / Daten
'Dreifacher Status: Ja

Private Sub chkFilterFertig_Click()
    Me.FilterOn = True
    Me.Requery
End Sub



'*********Optionsgruppe Filter Termine bis...**********

Private Sub ogrTermineBis_AfterUpdate()
 
    Select Case ogrTermineBis
        Case 1      'ALLE anzeigen
                Me.Filter = ""
                Me.FilterOn = True
                Me.txtDatumBis = Null
                           
        Case 2      'Alle Termine bis einschließlich Heute
                Me.Filter = "[DatumFertigSoll] < Date() +1"
                Me.FilterOn = True
               
        Case 3      'Alle Termine bis einschließlich Morgen
                Me.Filter = "[DatumFertigSoll] < Date() +2"
                Me.FilterOn = True
                               
        Case 4      'Alle Termine bis Ende der aktuellen Woche
                    'Berechne die aktuelle Anzahl der Tage in diesem Jahr und
                    'erzeuge daraus das Datum am Ende der Woche, mit dem verglichen wird.
       
                Me.Filter = "[DatumFertigSoll] <= " & Format(DateSerial(Year(Date), 1, Date - DateSerial(Year(Date), 1, 1) + 7 - Weekday(Date, 2)), "\#yyyy-mm-dd\#")
'                Me.Filter = "[DatumFertigSoll] < DateSerial(Year(date), Month(Date), Day(date) + 6 -Weekday(Date))"
                Me.FilterOn = True
                               
        Case 5      'Alle Termine bis Ende der aktueller Monat
                    'Letzter des Monats:  1. des Folgemonats minus 1 Tag
                Me.Filter = "[DatumFertigSoll] <= " & Format(DateSerial(Year(Date), Month(Date) + 1, 0), "\#yyyy-mm-dd\#")
'                Me.Filter = "[DatumFertigSoll] < DateSerial(iYear, iMonth + 1, 0)"
                Me.FilterOn = True
                   
               
                               
        Case 6      'Alle Termine bis eingegebenem Datum in Feld: Forms!TaskF!txtDatumBis
                    '
                If IsNull(Me!txtDatumBis) Then
                    MsgBox " Bitte tragen Sie ein Datum ein "
                    Me!ogrTermineBis = Null
                    Exit Sub
                Else
                    Me.Filter = "[DatumFertigSoll] <= " & Format(Nz(Me!txtDatumBis, Date) + 1, "\#yyyy-mm-dd\#")
'                    Me.Filter = "[DatumFertigSoll] <= " & Format(Me!txtDatumBis, "\#yyyy-mm-dd\#")
                    Me.FilterOn = True
                End If
        End Select
End Sub

'Nach Eintrag in Feld [txtDatumBis] wird ogrTermineBis auf NULL gesetzt:
Private Sub txtDatumBis_AfterUpdate()
    Me!ogrTermineBis = Null
End Sub
'*********************************************************************************



[Beaker s.a.]

Schade, dass du Eberhards Hinweis aus #13 nicht beachtet hast.

[Umbauwfb]

Schade, dass du Eberhards Hinweis aus #13 nicht beachtet hast.

------------------------------
Date() - mit Klammern, da verwendungsfähige Funktion - im SQL-String halte ich für besser, da man dann auf die zusätzliche Formatierung, die für einen Date-Wert von außen notwendig wird, verzichten kann. Macht das Ganze kürzer und weniger fehleranfällig (beim Schreiben).
------------------------------
Das fällt für mich in der Gesamtaussage leider immer noch in den Bereich "englische Gebrauchsanweisung"...
Ich würde Ratschläge gerne aufnehmen, wenn ich sie (als Code) einordnen  könnte...wie würde der Code denn aussehen?
------------------------------
Ich bin aber trotzdem sehr zufrieden damit, dass der Code - so wie er jetzt insgesamt geschrieben ist - alle Funktionalitäten, die zu erfüllen waren, erfüllt...

Harry

[DF6GL]

Hallo,


gemeint ist sowas wie dieses:

Me.Filter = "[DatumFertigSoll] < DateSerial(Year(Date()), Month(Date()), Day(Date()) + 6 -Weekday(Date()))"

Hier ist die Funktion "Date()" (wie auch die anderen)  Teil des Where-Condition-Strings und nicht Teil eines VBA-Ausdrucks. 

Die Funktion wird vom "Expression-Service" des Datenbankmoduls ausgewertet und braucht auch keine Umformatierung in das USA-, bzw. ISO-Format.   Allerdings sind in diesem Fall zwingend die Funktionsklammern erforderlich.


Wird die Where-Codition aber zunächst mit VBA zu einem String zusammengesetzt, wie hier:

Me.Filter = "[DatumFertigSoll] < " & Format(DateSerial(Year(Date), Month(Date), Day(Date) + 6 -Weekday(Date)), "\#yyyy-mm-dd\#")

sind die Klammern bei Date nicht erforderlich, bzw. werden von VBA entfernt, dafür muss aber das resultierende Datum zusätzlich in das USA- , bzw. ISO-Format konvertiert und als String formatiert werden.


Diese Umformatierungen erzeugen oft Tipp- oder andere Fehler und sind etwas undurchsichtiger.


Wenn das Kriterium aber eine VBA-Variable oder ein Steuerelement enthält, kann darauf der Expression-Service nicht direkt zugreifen und der Kriteriums-Ausdruck muss per VBA zusammengesetzt werden. (Es ist allerdings möglich, eine Public-Funktion zu erzeugen, die wiederum vom Expression-Service aufgelöst werden kann)

[Umbauwfb]

Danke für die fundierte Erklärung Franz!

Auch allen anderen nochmals herzlichen Dank für die Hilfe!
Und allen noch einen schönen letzten Osterfeiertag
Harry