Access-o-Mania

Hallo Zusammen,

bräuchte mal wieder Hilfe. Derzeit lasse ich über den nachfolgenden Code die Vereinszugehörigkeit in Jahren im Formular "frm_Vereinsjahre" und im Textfeld "ZVerein" anzeigen.

^{Private Function Get_VJahre() As Integer
'MAD 08-01-18
Dim dVAus As Date, dVDauer As Integer
    If Nz(Me![V_Austritt], 0) > 0 Then
        If Nz(Me![V_Austritt], 0) = 0 Then
            dVAus = Me![V_Austritt]
            dVDauer = dVAus - Me![V_Eintritt]
        Else
            dVAus = Me![V_Austritt]
            dVDauer = (dVAus - Me![V_Eintritt])
        End If
    Else
        dVDauer = (Nz(Me![V_Austritt], Date) - Nz(Me![V_Eintritt], Date))
    End If
    Get_VJahre = DatePart("yyyy", dVDauer + 2) - 1900
End Function}

Hier wird die Vereinzugehörigkeit in Jahren, aber Taggenau angezeigt. Soll heissen, bei Eintritt am 27.01.2016, wird heute eine Vereinzugehörigkeit von einem Jahr angeziegt. Erst am 28.01.2018 werden zwei Jahre angezeigt.

Nun möchte ich über ein ungebundenes Text "verjahre"mit einer Eingabe der "2", alle Filtern die zwei Jahre im Verein sind. Das oben beschriebene Beispiel dürfte hier noch nicht erscheinen.

Mit den derzeitigen Code funktioniert das aber irgendwie noch nicht.

^{Private Sub verjahre_AfterUpdate()
Me.Filter = "ZVerein =  " & Me.verjahre
Me.FilterOn = True
End Sub}

Was mache ich falsch?
Über Hilfe würde ich mich freuen.

Gruss
mad

Am besten ist man wohl mit einer Funktion in einem allgemeinen VBA-Modul bedient, der man über Argumente mit Ein- und Austrittsdatum versorgen kann.Public Function DauerInGanzenJahren(ByVal Anfangsdatum, Optional ByVal Vergleichsdatum)
   Dim Anfangstag   As Integer
   Dim Endtag       As Integer
   Dim Anfangsmonat As Integer
   Dim Endmonat     As Integer
   Dim Anfangsjahr  As Integer
   Dim Endjahr      As Integer

   'Liegt kein gültiges Anfangsdatum vor, Null als Ergebnis zurückgeben
   If Not IsDate(Anfangsdatum) Then
      DauerInGanzenJahren = Null
      Exit Function
   End If

   'Ist das Vergleichsdatum kein gültiger Datumswert, aktuelles Datum zum
   'Vergleich heranziehen
   If Not IsDate(Vergleichsdatum) Then Vergleichsdatum = VBA.Date()

   'Liegt das Vergleichsdatum vor dem Anfangsdatum, Null als Ergebnis
   'zurückgeben
   If Vergleichsdatum < Anfangsdatum Then
      DauerInGanzenJahren = Null
      Exit Function
   End If

   'Jahr, Monat und Tag des Anfangsdatums ermitteln
   Anfangsjahr = Year(Anfangsdatum)
   Anfangsmonat = Month(Anfangsdatum)
   Anfangstag = Day(Anfangsdatum)
   
   'Jahr, Monat und Tag des Vergleichsdatums ermitteln
   Endjahr = Year(Vergleichsdatum)
   Endmonat = Month(Vergleichsdatum)
   Endtag = Day(Vergleichsdatum)

   If Endmonat > Anfangsmonat Then
      DauerInGanzenJahren = Endjahr - Anfangsjahr
   ElseIf Endmonat < Anfangsmonat Then
      DauerInGanzenJahren = Endjahr - Anfangsjahr - 1
   ElseIf Endtag >= Anfangstag Then
      DauerInGanzenJahren = Endjahr - Anfangsjahr
   Else
      DauerInGanzenJahren = Endjahr - Anfangsjahr - 1
   End If
End Function
Alternativ könnte man auch donkarls FAQ 2.7 (http://www.donkarl.com/FAQ/FAQ2Allgemein.htm#2.7) umgestalten, die kürzeren Code verwendet - dafür aber längere Ausführungszeit beansprucht.

Wenn V_Eintritt und V_Austritt Feldnamen sind, könnte der Ausdruck so aussehen.Private Sub VerJahre_AfterUpdate()
   Me.Filter = "DauerInGanzenJahren(V_Eintritt, V_Austritt) = " & Nz(Me.VerJahre, 0)
   Me.FilterOn = True
End Sub

Hallo Lachtaube,

Habe den Code wie folgt auf meine Verhältnise geändert, bekomme aber dann im Feld fogendes Angezeigt #Name?.

<sub>Public Function Get_VJahre(ByVal V_Eintritt, Optional ByVal V_Austritt)
   Dim Anfangstag   As Integer
   Dim Endtag       As Integer
   Dim Anfangsmonat As Integer
   Dim Endmonat     As Integer
   Dim Anfangsjahr  As Integer
   Dim Endjahr      As Integer

   'Liegt kein gültiges V_Eintritt vor, Null als Ergebnis zurückgeben
   If Not IsDate(V_Eintritt) Then
      Get_VJahre = Null
      Exit Function
   End If

   'Ist das V_Austritt kein gültiger Datumswert, aktuelles Datum zum
   'Vergleich heranziehen
   If Not IsDate(V_Austritt) Then V_Austritt = VBA.Date()

   'Liegt das V_Austritt vor dem V_Eintritt, Null als Ergebnis
   'zurückgeben
   If V_Austritt < V_Eintritt Then
      Get_VJahre = Null
      Exit Function
   End If

   'Jahr, Monat und Tag des V_Eintritts ermitteln
   Anfangsjahr = Year(V_Eintritt)
   Anfangsmonat = Month(V_Eintritt)
   Anfangstag = Day(V_Eintritt)
   
   'Jahr, Monat und Tag des V_Austritts ermitteln
   Endjahr = Year(V_Austritt)
   Endmonat = Month(V_Austritt)
   Endtag = Day(V_Austritt)

   If Endmonat > Anfangsmonat Then
      Get_VJahre = Endjahr - Anfangsjahr
   ElseIf Endmonat < Anfangsmonat Then
      Get_VJahre = Endjahr - Anfangsjahr - 1
   ElseIf Endtag >= Anfangstag Then
      Get_VJahre = Endjahr - Anfangsjahr
   Else
      Get_VJahre = Endjahr - Anfangsjahr - 1
   End If
End Function</sub>


Was mache ich falsch?


Gruss
mad

Hallo,
Bin mir nicht sicher, ob es daran liegt, aber versuche

ZitatPrivate Sub VerJahre_AfterUpdate()
   Me.Filter = "Get_VJahre(Me.V_Eintritt, Me.V_Austritt) = " & Nz(Me.VerJahre, 0)
   Me.FilterOn = True
End Sub

gruss ekkehard

Hallo Beaker s.a.,

wie geschrieben, bekomme ich im Textfeld "ZVerein" noch gar keine Zahlen angezeigt. Darum kann ich noch nicht überprüfen ob der Filter funktionieren würde.
Ich bräuchte erst Hilfe zur Funktion "Public Function Get_VJahre(ByVal V_Eintritt, Optional ByVal V_Austritt)"

Danke
mad

Zitat von: mad am Januar 27, 2018, 17:09:38Ich bräuchte erst Hilfe zur Funktion "Public Function Get_VJahre(ByVal V_Eintritt, Optional ByVal V_Austritt)"

Mir ist unklar warum du nicht einfach die fertige und funktionierende Funktion von Lachtaube übernommen hast.

Anders als vorgeschlagen, würde ich diese Funktion aber schon in die Abfrage, welche die Datenherkunft des Formulars darstellt, übernehmen. Dein Feld bindest du dann einfach an das entsprechende Feld mit dem Funktionsrückgabewert der Abfrage.

Schau mal, ob der Anhang Deinem Wunsch entgegen kommt?

Perfekt.


Danke
mad