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.
Poznámka
Ukázku techniky použité v tomto článku najdete v ukázkovém souboru Qrysmp00.exe.
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.
Důležité
Následující postup vás vyzve ke změně data v počítači. Ujistěte se, že jste dokončili krok 6 a obnovili datum na aktuální datum.
Pomocí nástroje Datum a čas v Ovládací panely si poznamenejte aktuální datum a nastavte datum na 3. června 2001.
Otevřete modul nebo vytvořte nový.
V nabídce Zobrazení klikněte na Okamžité okno.
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).
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ů.
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.
V Northwind.mdb ukázkové databáze zadejte v novém modulu funkce Age() a AgeMonth().
Otevřete formulář Objednávky v návrhovém zobrazení a přidejte ovládací prvek nevázaného textového pole.
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"
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.
Váš názor
https://aka.ms/ContentUserFeedback.
Připravujeme: V průběhu roku 2024 budeme postupně vyřazovat problémy z GitHub coby mechanismus zpětné vazby pro obsah a nahrazovat ho novým systémem zpětné vazby. Další informace naleznete v tématu:Odeslat a zobrazit názory pro