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é
Hallo,
Versuch es mal mit dieser Funktion:
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
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é
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):
=YMDgoneexaktKH(Datum(); Eintritt)
Eventuell Datum() und Eintritt tauschen.
In der Funktion musst Du noch das gewünschte Ausgabeformat aktivieren (' entfernen).
Hallo Klaus,
Fehlt da nicht der Rückgabewert?
gruss ekkehard
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.
... + 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).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
Hallo Klaus,
Ja, an Variant hatte ich im Zusammenhang mit dem Rückgabewert einer
Function nicht gedacht; - alles klar.
gruss ekkehard