Jak v Accessu vytvořit dvě funkce pro výpočet věku v měsících a letech

Pokročilé: Vyžaduje odborné kódování, interoperabilitu a víceuživatelské dovednosti.

Tento článek se týká databáze aplikace Microsoft Office Access (.accdb a .mdb) a projektu Aplikace Microsoft Access (.apd).

Souhrn

V tomto článku se dozvíte, jak vytvořit dvě funkce, které můžete použít k výpočtu věku osoby nebo věci na základě zadaného data.

Další informace

Vytváření funkcí

Do modulu zadejte nebo vložte následující kód:

'==========================================================
' General Declaration
'==========================================================
Option Explicit

'*************************************************************
' FUNCTION NAME: Age()
'
' PURPOSE:
'    Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
'    StartDate: The beginning date (for example, a birth date).
'
' RETURN
'    Age in years.
'
'*************************************************************
Function Age (varBirthDate As Variant) As Integer
   Dim varAge As Variant

If IsNull(varBirthdate) then Age = 0: Exit Function

varAge = DateDiff("yyyy", varBirthDate, Now)
   If Date < DateSerial(Year(Now), Month(varBirthDate), _
                        Day(varBirthDate)) Then
      varAge = varAge - 1
   End If
   Age = CInt(varAge)
End Function

'*************************************************************
' FUNCTION NAME: AgeMonths()
'
' PURPOSE:
'  Compliments the Age() function by calculating the number of months
'  that have expired since the last month supplied by the specified date.
'  If the specified date is a birthday, the function returns the number of
'    months since the last birthday.
'
' INPUT PARAMETERS:
'    StartDate: The beginning date (for example, a birthday).
'
' RETURN
'    Months since the last birthday.
'*************************************************************
Function AgeMonths(ByVal StartDate As String) As Integer

Dim tAge As Double
   tAge = (DateDiff("m", StartDate, Now))
   If (DatePart("d", StartDate) > DatePart("d", Now)) Then
      tAge = tAge - 1
   End If
   If tAge < 0 Then
      tAge = tAge + 1
   End If

AgeMonths = CInt(tAge Mod 12)

End Function

Testování funkcí Age() a AgeMonths()

Pokud chcete otestovat funkce Age() a AgeMonths(), postupujte takto.

1. Pomocí nástroje Datum a čas v Ovládací panely si poznamenejte aktuální datum a nastavte datum na 3. června 2001.

2. Otevřete modul nebo vytvořte nový.

3. V nabídce Zobrazení klikněte na Okamžité okno.

4. Předpokládejme, že datum narození vašeho přítele bylo 15. listopadu 1967 a dnes je 3. června 2001. Do okna Immediate zadejte následující řádek a stiskněte klávesu ENTER:

   ? Age("11/15/67")

   Všimněte si, že Microsoft Access reaguje hodnotou 33 (roky).

5. Zadejte následující řádek a stiskněte klávesu ENTER:

   ? AgeMonths("11/15/67")

   Všimněte si, že Microsoft Access odpoví hodnotou 6, která označuje, že od posledních narozenin této osoby uplynulo šest měsíců. Tvůj přítel má 33 let a šest měsíců.

6. Pomocí nástroje Datum a čas v Ovládací panely obnovte datum na aktuální datum, které jste si poznamenali v kroku 1.

Použití funkcí Age() a AgeMonths()

Následující postup vysvětluje, jak označit staré objednávky umístěním hodnoty stáří do nového ovládacího prvku.

1. V Northwind.mdb ukázkové databáze zadejte v novém modulu funkce Age() a AgeMonth().

2. Otevřete formulář Objednávky v návrhovém zobrazení a přidejte ovládací prvek nevázaného textového pole.

3. Do pole ControlSource (Zdroj ovládacího prvku) ovládacího prvku nového textového pole zadejte následující řádek:

   =Age([DatumObjednávky]) & " yrs " & AgeMonths([DatumObjednávky]) & " mos"

4. Zobrazte formulář ve formulářovém zobrazení. Všimněte si, že stáří objednávky se zobrazuje v novém ovládacím prvku textové pole.

Odkazy

Další informace o rozdílech kalendářních dat získáte v Editor jazyka Visual Basic kliknutím na příkaz Nápověda pro Microsoft Visual Basic v nabídce Nápověda, zadejte funkci datediff v Pomocníkovi Office nebo v Průvodci odpověďmi a kliknutím na tlačítko Hledat zobrazte téma.