Calculate date of birth

1

1aae

I have take this function from MVP Access Site:

Is there any MVP ENG tell me how can I use this function:
How can I calculate the difference between today date (system date) computer
date and (date of birth)…

I have only txtboxdateof birth user enter the date of birth msgbox display
the AGE
thank you

Function CalcAge(vDate1 As Date, vDate2 As Date, ByRef vYears As Integer,
ByRef vMonths As Integer, ByRef vDays As Integer)
' Comments : calculates the age in Years, Months and Days
' Parameters:
' vDate1 - D.O.B.
' vDate2 - Date to calculate age based on
' vYears - will hold the Years difference
' vMonths - will hold the Months difference
' vDays - will hold the Days difference
vMonths = DateDiff("m", vDate1, vDate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vDate2)
If vDays < 0 Then
' wierd way that DateDiff works, fix it here
vMonths = vMonths - 1
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vDate2)
End If
vYears = vMonths \ 12 ' integer division
vMonths = vMonths Mod 12 ' only want leftover less than one year
End Function
 
V

Vítor Barbosa

Hi,

1. Select txtboxdateofbirth. Go to properties > events > Afterupdate. Click
twice over this field.
2. Click on the ... button. You should go to VB Editor.
3. You should see something like this

Private Sub txtboxdateofbirth_Afterupdate ()

End Sub

4. Now just enter this code:

'*************************************************************
Private Sub txtboxdateofbirth_Afterupdate ()
Dim Age as Integer, BDate as Date

BDate = Nz(txtboxdateofbirth.value, Now())
' MVP Access Site function
Age=DateDiff("yyyy", [Bdate], Now()) + Int( Format(now(), "mmdd") <
Format( [Bdate], "mmdd") )
MsgBox Age

End Sub
'*************************************************************

5. Now it should work. Note that I haven't tested it. This code was writed
here, so there may be some syntax errors.


Vítor Barbosa
 
V

Vítor Barbosa

Hi.

Just one more thing. I've been thinking and there a "simple" change to do to
work better. (now tested)

'***** code start **************
Private Sub txtboxdateofbirth_Afterupdate()
Dim Age As Integer, BDate As Date

' BDate = Nz(txtboxdateofbirth.value, Now()) > this line changes to:
BDate = Nz(txtboxdateofbirth.Value, 0)
If BDate = 0 Then
MsgBox "Please enter a valid date!"
txtboxdateofbirth.SetFocus
Exit Sub
End If
' MVP Access Site function
Age = DateDiff("yyyy", [BDate], Now()) + Int(Format(Now(), "mmdd") <
Format([BDate], "mmdd"))
MsgBox "You're " & Age & " years old."

End Sub

Private Sub txtboxdateofbirth_KeyDown(KeyCode As Integer, Shift As Integer)

' Just in case the user press ENTER before write a valid date
Select Case KeyCode
Case vbKeyReturn
Call txtboxdateofbirth_Afterupdate
End Select

End Sub


***********code end ***********

Vítor Barbosa
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top