Berechneter Zeitraum

[Tally]

Hallo zusammen
Ich habe in einem Formular das Feld Eintritt (Datum, kurz) und möchte in einem ungebundenen Textfeld die Anzahl Jahre, Monate und Tage bis heute ausgeben. Die aktuelle Lösung sieht bei mir wie folgt aus:
=(DateDiff("t";Datum();[Eintritt]))/365
Ich kann zwar mit dieser Lösung leben, es wäre aber komfortabler, wenn das Resultat nicht bei einem Eintrittsdatum vom 11.07.2013 als Lösung 5.09 sondern 5 Jahre, 1 Monat, 1 Tag ausgeben würde. Luxus oben drauf wäre noch die Anzahl Monate und Tage bis zum nächsten (6.) vollen Jahr, dies natürlich in einem zweiten Textfeld 
Ist dies überhaupt in Access möglich? Vielen Dank für Eure Hilfe.
Gruss René

[MzKlMu]

Hallo,
Versuch es mal mit dieser Funktion:

Code [Auswählen] Erweitern

Function YMDgoneexaktKH(argdate1 As Date, argdate2 As Date)

' ergibt die Differenz zwischen dem beim Aufruf übergebenen argdate1 und
' argdate2 in Jahren, Monaten und Tagen
' Aufgerufen wird die Funktion mit z.B.: YMDgoneexaktKH([Geburtsdatum];[Todesdatum])

   Dim Ygone As Integer, Mgone As Byte, Dgone As Byte
   If IsNull(argdate1) Or argdate1 > argdate2 Then Exit Function
   Ygone = DateDiff("yyyy", argdate1, argdate2) + Int(Format(argdate2, "mmdd") < Format(argdate1, "mmdd"))
   Mgone = Int((DateDiff("m", argdate1, argdate2) + Int(Format(argdate2, "dd") < Format(argdate1, "dd")))) Mod 12
   If Day(argdate1) <= Day(argdate2) Then
      Dgone = Format(argdate2, "dd") - Format(argdate1, "dd")
   Else
      Dgone = Day(DateSerial(Year(argdate1), Month(argdate1) + 1, 0)) - Day(argdate1) + Day(Date)
   End If
   
   '** Das wäre eine Art, das Ergebnis auszugeben...:
        'YMDgoneexaktKH = Ygone & " Jahr" & IIf(Ygone = 1, " ", "e ") _
        '& Mgone & " Monat" & IIf(Mgone = 1, " ", "e ") _
        '& Dgone & " Tag" & IIf(Dgone = 1, " ", "e")
   
   '** ...und das ist die platzsparendere Art:
        YMDgoneexaktKH = Ygone & "  J. " & Mgone & " Mt. " & Dgone & " Tg."
   
   '** ...und das wäre eine dritte Version:
        'YMDgoneexaktKH = Ygone & " / " & Mgone & " / " & Dgone
End Function

[Tally]

Hallo Klaus
Wie kann ich diese Funktion in ein ungebundenes Textfeld einbetten? Das Ziel ist, dass der Wert beim Aufruf des Formulars direkt angezeigt wird, also ohne das Feld anzuklicken oder sonst wie zu aktualisieren? Aktuell habe ich lediglich den Steuerelementinhalt mit meiner Formel belegt.
Gruss René

[MzKlMu]

Hallo,
die Funktion muss in ein allgemeines Modul, das nicht den gleichen Namen wie die Funktion haben darf.
Aufruf im ungebundenen Feld (wie Datdiff auch):

Code [Auswählen] Erweitern

=YMDgoneexaktKH(Datum(); Eintritt)
Eventuell Datum() und Eintritt tauschen.
In der Funktion musst Du noch das gewünschte Ausgabeformat aktivieren (' entfernen).

[Beaker s.a.]

Hallo Klaus,
Fehlt da nicht der Rückgabewert?
gruss ekkehard

[MzKlMu]

Hallo,
ich wüsste nicht, dass da was fehlt.
Die Funktion liefert einen Variantwert zurück.

Die Funktion ist auch nicht von mir, hatte ich nur in meinem Fundus.

[Lachtaube]

... + Day(Date) hat in der Funktion bestimmt nichts verloren.

Zum Anderen sind Zeitangaben in Perioden größer als Wochen eher informativ zu betrachten, weil ihre Größen schwanken. Das im Bewußsein würde ich die Funktion von Klaus aufdröseln und ggf.eine Funktion nach eigenen Vorstellungen zusammensetzen (hier als Beispiel: GetElapsedYMDString).

Code [Auswählen] Erweitern

Private Sub ElapsedYMD(ByVal PastDate As Date, ByVal FutureDate As Date, _
                       YearVal As Long, Optional MonthVal As Long, _
                       Optional DayVal As Long)

   ' Gibt die Differenz zwischen PastDate und FutureDate
   ' in YearVal, MonthVal und DayVal aus

   Static OldPastDate   As Date
   Static OldFutureDate As Date
   
   Static OldYearVal    As Long
   Static OldMonthVal   As Long
   Static OldDayVal     As Long

   Dim TempDate         As Date

   Dim YearCorrection   As Long
   Dim MonthCorrection  As Long
   Dim DayCorrection    As Long

   Dim PastMonth        As Long
   Dim PastDay          As Long

   Dim FutureMonth      As Long
   Dim FutureDay        As Long

   'ggf.Argumente tauschen
   If PastDate > FutureDate Then
      TempDate = FutureDate
      FutureDate = PastDate
      PastDate = TempDate
   End If

   If OldPastDate <> PastDate Or OldFutureDate <> FutureDate Then
      OldPastDate = PastDate: OldFutureDate = FutureDate

      PastMonth = Month(PastDate): PastDay = Day(PastDate)
      FutureMonth = Month(FutureDate): FutureDay = Day(FutureDate)

      'Korrekturen enthalten entweder 0 oder -1 als Wert
      YearCorrection = Int(FutureMonth + 100 + FutureDay < PastMonth * 100 + PastDay)
      MonthCorrection = Int(FutureDay < PastDay)

      OldYearVal = DateDiff("yyyy", PastDate, FutureDate) + YearCorrection
      OldMonthVal = (DateDiff("m", PastDate, FutureDate) + MonthCorrection) Mod 12

      If Day(PastDate) <= Day(FutureDate) Then
         OldDayVal = FutureDay - PastDay
      Else
         'letzten Tag des Monats zur Berechnung heranziehen
         OldDayVal = Day(DateSerial(Year(PastDate), Month(PastDate) + 1, 0)) _
                   - PastDay + FutureDay
      End If
   End If
   YearVal = OldYearVal
   MonthVal = OldMonthVal
   DayVal = OldDayVal
End Sub

Public Function GetElapsedYears(ByVal PastDate As Date, _
                                ByVal FutureDate As Date) As Long
   ElapsedYMD PastDate, FutureDate, GetElapsedYears
End Function

Public Function GetElapsedMonths(ByVal PastDate As Date, _
                                 ByVal FutureDate As Date) As Long
   Dim y As Long
   ElapsedYMD PastDate, FutureDate, y, GetElapsedMonths
End Function

Public Function GetElapsedDays(ByVal PastDate As Date, _
                               ByVal FutureDate As Date) As Long
   Dim y As Long, m As Long
   ElapsedYMD PastDate, FutureDate, y, m, GetElapsedDays
End Function

Public Function GetElapsedYMDString(ByVal PastDate As Date, _
                                    ByVal FutureDate As Date, _
                                    Optional ByVal ShortFmt As Boolean = True) As String
   Dim y As Long, m As Long, d As Long
   ElapsedYMD PastDate, FutureDate, y, m, d

   If ShortFmt Then
      GetElapsedYMDString = CStr(y) & " J, " & _
                            CStr(m) & " M, " & _
                            CStr(d) & "T"
   Else
      If y = 1 Then
         GetElapsedYMDString = CStr(y) & " Jahr, "
      Else
         GetElapsedYMDString = CStr(y) & " Jahre, "
      End If
      If m = 1 Then
         GetElapsedYMDString = GetElapsedYMDString & CStr(m) & " Monat, "
      Else
         GetElapsedYMDString = GetElapsedYMDString & CStr(m) & " Monate, "
      End If
      If d = 1 Then
         GetElapsedYMDString = GetElapsedYMDString & CStr(d) & " Tag"
      Else
         GetElapsedYMDString = GetElapsedYMDString & CStr(d) & " Tage"
      End If
   End If
End Function

[Beaker s.a.]

Hallo Klaus,
Ja, an Variant hatte ich im Zusammenhang mit dem Rückgabewert einer
Function nicht gedacht; - alles klar.
gruss ekkehard