#Fout bij het berekenen van leeftijd

  • Onderwerp starter Onderwerp starter smko
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.

smko

Gebruiker
Lid geworden
30 aug 2011
Berichten
12
ik heb de module gebruikt die hier op het forum te vinden was voor de leeftijd te berekenen. Ik zou er graag 2 zaken aan veranderen maar weet niet hoe.

Omdat ik niet altijd de GeboorteDatum ken van de aangekochte vogel is soms het veld leeg. Maar in de query Leeftijd waar ik de module oproep komt nu in het veld leeftijd #Fout te staan. Dit veld zou leeg moeten blijven.
Het andere is dat men ook de 0 jaren/maanden/ of dagen ziet. Ik zou graag de volgende notatie hebben. Vb : 0 jaren 0 maanden en 2 dagen, het zou 2 dagen moeten aangeven.

Kan iemand mij hierbij helpen.
 

Bijlagen

De foutmelding kun je afvangen door een check op de datum.
Code:
Leeftijd: IIf([GebDatAangekochteVogel] Is Null;"";CalcAge([GebDatAangekochteVogel];Date()))
Voor het andere deel van je vraag moet je de functie aanpassen, en daar een check inbouwen op de verschillende 0-waarden.
 
Waar plaats ik die check, in de module of query .... ?
Is er een mogelijkheid dat je me met het tweede punt verder kan helpen, ben nog niet zo vertrouwd met vba.

Alvast bedankt
 
Ik ben er mee bezig geweest, maar het is nog niet af. Even geduld dus :).
 
Ik heb 'm aangepast in de functie die ik zelf gebruik, maar je kunt dat vast zelf wel aanpassen. Of je gebruikt de mijne :)
Code:
Public Function Age(BirthDate As Date, RefDate As Date) As String
Dim iYr As Integer, iM As Integer, iD As Integer
Dim tmpDate As Date

    If IsNull(RefDate) Then RefDate = Date
    iYr = DateDiff("yyyy", BirthDate, RefDate) + (RefDate < DateSerial(Year(RefDate), Month(BirthDate), Day(BirthDate)))
    tmpDate = DateSerial(Year(BirthDate) + iYr, Month(BirthDate), Day(BirthDate))
    iM = DateDiff("m", tmpDate, RefDate) +     iM = DateDiff("m", tmpDate, RefDate) + Day(Date) < Day(BirthDate)
    tmpDate = DateSerial(Year(BirthDate) + iYr, Month(BirthDate) + iM, Day(BirthDate))
    iD = DateDiff("d", tmpDate, RefDate)
    If iYr >= 1 Then
        Age = iYr & " jaar "
    End If
    If iM = 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maand"
    ElseIf iM > 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maanden"
    End If
    If iD = 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & "1 dag"
    ElseIf iD > 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & iD & " dagen"
    End If

End Function
 
Nog een laatste bugje:

Code:
Public Function Age(BirthDate As Date, RefDate As Date) As String
    Dim iYr As Integer, iM As Integer, iD As Integer
    Dim tmpDate As Date


    iYr = DateDiff("yyyy", BirthDate, RefDate) + (RefDate < DateSerial(Year(RefDate), Month(BirthDate), Day(BirthDate)))
    iM = DateDiff("m", BirthDate, RefDate) Mod 12 + (Day(RefDate) < Day(BirthDate))
    tmpDate = DateSerial(Year(BirthDate) + iYr, Month(BirthDate) + iM, Day(BirthDate))
    iD = DateDiff("d", tmpDate, RefDate)
    If iYr >= 1 Then
        Age = iYr & " jaar"
    End If
    If iM = 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maand"
    ElseIf iM > 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maanden"
    End If
    If iD = 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & "1 dag"
    ElseIf iD > 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & iD & " dagen"
    End If
End Function
 
Laatst bewerkt:
Ok dat werkt nu perfect, enkel ik heb nog steeds in de query #Fout staan waar het veld null is. Hoe kan ik dit nog oplossen ?
 
Door je query aan te passen, zie ook post# 2:

Code:
Leeftijd: IIf([GebDatAangekochteVogel] Is Null;"";Age([GebDatAangekochteVogel];Date()))
 
ok bedankt, dacht dat de code in de module bij moest komen. Alles werkt nu prima.
Waar sluit ik het onderwerp af
 
@OctaFish. Ik ben geboren op 20-9-1968. Volgens jouw code uit post# 6 ben ik 46 jaar en 179 dagen oud. Nou ben ik geen duif natuurlijk, maar de uitkomst is onjuist en bovendien is de notatie niet zoals ts die vroeg. Er ging iets mis bij de berekening van iM. Bugje dus.
 
Je hebt de betekenis van 'bug' nog niet helemaal uitgekristalliseerd want de uitkomst is wel correct, al zie je de maanden niet maar de dagen na de verjaardag. Maar er zit wel een klein foutje in mijn functie: er ontbreken 2 haakjes. Die zijn bij het opschonen vermoed ik gesneuvelde :).
Code:
Public Function Age(BirthDate As Date, RefDate As Date) As String
Dim iYr As Integer, iM As Integer, iD As Integer
Dim tmpDate As Date

    If IsNull(RefDate) Then RefDate = Date
    iYr = DateDiff("yyyy", BirthDate, RefDate) + (RefDate < DateSerial(Year(RefDate), Month(BirthDate), Day(BirthDate)))
    tmpDate = DateSerial(Year(BirthDate) + iYr, Month(BirthDate), Day(BirthDate))
    iM = DateDiff("m", tmpDate, RefDate) + (Day(Date) < Day(BirthDate))
    tmpDate = DateSerial(Year(BirthDate) + iYr, Month(BirthDate) + iM, Day(BirthDate))
    iD = DateDiff("d", tmpDate, RefDate)
    If iYr >= 1 Then
        Age = iYr & " jaar "
    End If
    If iM = 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maand"
    ElseIf iM > 1 Then
        If Age & "" <> "" Then Age = Age & ", "
        Age = Age & iM & " maanden"
    End If
    If iD = 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & "1 dag"
    ElseIf iD > 1 Then
        If Age & "" <> "" Then Age = Age & " en "
        Age = Age & iD & " dagen"
    End If

End Function
 
Laatst bewerkt:
De uitkomst was niet correct; het aantal dagen had 148 moeten zijn in mijn voorbeeld in post# 12.
Overigens kwalificeert het ontbreken van haakjes wat mij betreft ook als een bugje.
 
Laatst bewerkt:
In ieder geval bedankt voor het attenderen op het 'foutje'. Het was natuurlijk nooit de bedoeling om de leeftijd in jaren en dagen te berekenen. Ik snap ook niet helemaal dat die haakjes verdwenen waren, maar swa, ken gebeuren :). Mét haakjes werkt hij in ieder geval perfect :D.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan