År, måneder og dage mellem en given dato og en dato frem i tiden

Jeg har en testdb til beregning af alder. Jeg kan ikke huske hvad den egentlig kan. Vil du have de, må du lægge din e-mail.

Vil gerne prøve at kigge på den
admin@pavon.dk

Sendt.

Takker. Jeg kigger på den så hurtigt som muligt og giver besked om det duer :-)

OK

Den regner desværre kun alderen ud i år, så kan ikke bruges... Ellers tak

OK

A More Complete DateDiff Function
As it states, it lets you calculate a "precise" difference between two date/time values.
You specify how you want the difference between two date/times to be calculated by providing which of ymdhns (for years, months, days, hours, minutes and seconds) you want calculated.
For example:
?Diff2Dates("y", #06/01/1998#, #06/26/2002#)
4 years
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#)
4 years 25 days
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#, True)
4 years 0 months 25 days
?Diff2Dates("d", #06/01/1998#, #06/26/2002#)
1486 days

?Diff2Dates("h", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours
?Diff2Dates("hns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours 47 minutes 33 seconds
?Diff2Dates("dhns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
1 day 18 hours 47 minutes 33 seconds

?Diff2Dates("ymd",#12/31/1999#,#1/1/2000#)
1 day
?Diff2Dates("ymd",#1/1/2000#,#12/31/1999#)
-1 day
?Diff2Dates("ymd",#1/1/2000#,#1/2/2000#)
1 day

________________________________________
'***************** Code Start **************
Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _
Optional ShowZero As Boolean = False) As Variant
'
'Description:  This function calculates the number of years,
'              months, days, hours, minutes and seconds between
'              two dates, as elapsed time.
'
'Inputs:    Interval:  Intervals to be displayed (a string)
'          Date1:      The lower date (see below)
'          Date2:      The higher date (see below)
'          ShowZero:  Boolean to select showing zero elements
'
'Outputs:  On error: Null
'          On no error: Variant containing the number of years,
'              months, days, hours, minutes & seconds between
'              the two dates, depending on the display interval
'              selected.
'          If Date1 is greater than Date2, the result will
'              be a negative value.
'          The function compensates for the lack of any intervals
'              not listed. For example, if Interval lists "m", but
'              not "y", the function adds the value of the year
'              component to the month component.
'          If ShowZero is True, and an output element is zero, it
'              is displayed. However, if ShowZero is False or
'              omitted, no zero-value elements are displayed.
'              For example, with ShowZero = False, Interval = "ym",
'              elements = 0 & 1 respectively, the output string
'              will be "1 month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

  Dim booCalcYears As Boolean
  Dim booCalcMonths As Boolean
  Dim booCalcDays As Boolean
  Dim booCalcHours As Boolean
  Dim booCalcMinutes As Boolean
  Dim booCalcSeconds As Boolean
  Dim booSwapped As Boolean
  Dim dtTemp As Date
  Dim intCounter As Integer
  Dim lngDiffYears As Long
  Dim lngDiffMonths As Long
  Dim lngDiffDays As Long
  Dim lngDiffHours As Long
  Dim lngDiffMinutes As Long
  Dim lngDiffSeconds As Long
  Dim varTemp As Variant

  Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
  Interval = LCase$(Interval)
  For intCounter = 1 To Len(Interval)
      If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
        Exit Function
      End If
  Next intCounter

'Check that valid dates have been entered
  If Not (IsDate(Date1)) Then Exit Function
  If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
  If Date1 > Date2 Then
      dtTemp = Date1
      Date1 = Date2
      Date2 = dtTemp
      booSwapped = True
  End If

  Diff2Dates = Null
  varTemp = Null

'What intervals are supplied
  booCalcYears = (InStr(1, Interval, "y") > 0)
  booCalcMonths = (InStr(1, Interval, "m") > 0)
  booCalcDays = (InStr(1, Interval, "d") > 0)
  booCalcHours = (InStr(1, Interval, "h") > 0)
  booCalcMinutes = (InStr(1, Interval, "n") > 0)
  booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
  If booCalcYears Then
      lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
              IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
      Date1 = DateAdd("yyyy", lngDiffYears, Date1)
  End If

  If booCalcMonths Then
      lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
              IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
      Date1 = DateAdd("m", lngDiffMonths, Date1)
  End If

  If booCalcDays Then
      lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
      Date1 = DateAdd("d", lngDiffDays, Date1)
  End If

  If booCalcHours Then
      lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
              IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
      Date1 = DateAdd("h", lngDiffHours, Date1)
  End If

  If booCalcMinutes Then
      lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
              IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
      Date1 = DateAdd("n", lngDiffMinutes, Date1)
  End If

  If booCalcSeconds Then
      lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
      Date1 = DateAdd("s", lngDiffSeconds, Date1)
  End If

  If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
      varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
  End If

  If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
      If booCalcMonths Then
        varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                  lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
      End If
  End If

  If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
      If booCalcDays Then
        varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                  lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
      End If
  End If

  If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
      If booCalcHours Then
        varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                  lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
      End If
  End If

  If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
      If booCalcMinutes Then
        varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                  lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
      End If
  End If

  If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
      If booCalcSeconds Then
        varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                  lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
      End If
  End If

  If booSwapped Then
      varTemp = "-" & varTemp
  End If

  Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
  Exit Function

Err_Diff2Dates:
  Resume End_Diff2Dates

End Function
'************** Code End *****************

Jeg lavede et eksempel med 3 tekstfelter: BornDate, ShowDate og Age
og så en knap kaldet InsertAge:

Private Sub InsertAge_Click()
Dim Y, Yb, Ys, M, Mb, Ms, Db, Ds
Yb = Format(Me.BornDate, "yyyy", vbUseSystemDayOfWeek, vbUseSystem)
Ys = Format(Me.ShowDate, "yyyy", vbUseSystemDayOfWeek, vbUseSystem)
Mb = Format(Me.BornDate, "mm", vbUseSystemDayOfWeek, vbUseSystem)
Ms = Format(Me.ShowDate, "mm", vbUseSystemDayOfWeek, vbUseSystem)
Db = Format(Me.BornDate, "dd", vbUseSystemDayOfWeek, vbUseSystem)
Ds = Format(Me.ShowDate, "dd", vbUseSystemDayOfWeek, vbUseSystem)

If Mb > Ms Then
    If Db > Ds Then
    Y = Ys - Yb - 1
    M = Ms - Mb + 11
    Else
    Y = Ys - Yb - 1
    M = Ms - Mb + 12
    End If
Else
    If Db > Ds Then
    Y = Ys - Yb
    M = Ms - Mb - 1
    Else
    Y = Ys - Yb
    M = Ms - Mb
    End If
End If

If M = 1 Then
Me.Age = Y & " år og " & M & " måned"
Else
Me.Age = Y & " år og " & M & " måneder"
End If
End Sub

Du må hellere tjekke efter, men jeg mener det regner rigtigt!~)

Hej begge 2

Jeg kigger på dem begge i aften, når dagens mindre vigtige pligter er overstået. Jeg kender til dels Terry's eksempel, men tror jeg er for forvirret til at bruge det :-) Giver lyd, når jeg når så langt.

Hej spg

Imiddelbart ser det ud som om, at den virker, men der er ingen dage i "outputtet"? *plirrer sødt med øjnene"

Private Sub InsertAge_Click()
Dim Y, YY, Yb, Ys, M, MM, Mb, Ms, Db, Ds, D
Yb = Format(Me.BornDate, "yyyy", 0, 0)
Ys = Format(Me.ShowDate, "yyyy", 0, 0)
Mb = Format(Me.BornDate, "mm", 0, 0)
Ms = Format(Me.ShowDate, "mm", 0, 0)
Db = Format(Me.BornDate, "dd", 0, 0)
Ds = Format(Me.ShowDate, "dd", 0, 0)

If Mb > Ms Then
    If Db > Ds Then
    Y = Ys - Yb - 1
    M = Ms - Mb + 11
    Else
    Y = Ys - Yb - 1
    M = Ms - Mb + 12
    End If
Else
    If Db > Ds Then
    Y = Ys - Yb
    M = Ms - Mb - 1
    Else
    Y = Ys - Yb
    M = Ms - Mb
    End If
End If

If (Format(Me.BornDate, "mm") + M) > 12 Then
MM = (Format(Me.BornDate, "mm") + M) - 12
YY = (Format(Me.BornDate, "yyyy", 0, 0) + Y) + 1
Else
MM = (Format(Me.BornDate, "mm") + M)
YY = (Format(Me.BornDate, "yyyy", 0, 0) + Y)
End If

D = Format(Me.BornDate, "dd") & "-" & MM & "-" & YY
D = DateDiff("d", D, Me.ShowDate, 0, 0)

If M = 1 Then
    If D = 1 Then
    Me.Age = Y & " år og " & M & " måned og " & D & " dag."
    Else
    Me.Age = Y & " år og " & M & " måned og " & D & " dage."
    End If
Else
    If D = 1 Then
    Me.Age = Y & " år og " & M & " måneder og " & D & " dag."
    Else
    Me.Age = Y & " år og " & M & " måneder og " & D & " dage."
    End If
End If
End Sub

spg: Ser ud til den virker, så skal jeg bare lege med at få det til at virke i rapporten. Tusind Tak :-D

!~)