• Home
 · 
• Math/Dates
 · 
• Can calculate your age (in years and months), and even takes the LeapYear into account. Only uses a

Can calculate your age (in years and months), and even takes the LeapYear into account. Only uses a

Can calculate your age (in years and months), and even takes the LeapYear into account. Only uses a few simple functions... Fully functional

API Declarations



' *********************************************
' * Coded by: '][' o r p i d ]P r e y *
' * [email protected] *
' *********************************************


'==================Instructions==================
'Include Anywhere, just read 'em ffs

'A lot of this code is just making it look presenentable. It is not all necessary, but the
'functions in the module below are!

'Use this code however you want just don't be a dipsh*t and pretend that you wrote it

'This is an easy way to calculate someones age. Place the following items anywhere on the form
'Label1
'Label2
'Text1
'Command1

'I know it is easier to select a date from the DTPicker but this saves people dicking around
'with components when they just want the functions, cuz I hate it when other people do that.

'This should work from just a standard form with 2 labels, a text box and a command button
'all with their default names

'Make the project start in Sub Main, and change;
'Form1.Maxbutton = False
'Form1.Borderstyle = 2 - Sizable


'==================Declarations==================
'In Module

Option Explicit

Public BDay As Date
Public Months As Integer
Public Const DAYSinYEAR As Integer = 365.25

'==================Functions==================
'In Module

Public Function Age(Birthday As String) As Single
' ^
'*** 'Birthday is declared as a String beacause I am using a textbox...
'You can change it to Birthday as Date if you are going to pre-formatted
'dates rather than string text dates such as that from a DTPicker...

Dim Days As Long

Days = DateDiff("d", Birthday, Date)
If IsLeapYear(Year(BDay)) = True Then
'If the Birthday is before LeapYearInstance for the same year, then... else...
If DateDiff("d", LeapYearInstance(BDay), BDay) < 0 Then
' Prior to Feb 29
Else
' Feb 29 or Later
Days = Days + 1
End If
End If
Months = AgeMonths(Days / DAYSinYEAR)
Age = Int(Days / DAYSinYEAR)
End Function

Public Function AgeMonths(AgeYears As Single) As Integer
AgeMonths = (AgeYears - Int(AgeYears)) * 12
End Function

Public Function IsLeapYear(Yr As Integer) As Boolean
Dim i As Byte
IsLeapYear = True
On Error GoTo No_29th_Feb
'You need to try to obtain it to set off the Error
i = Weekday("29/02/" & Yr)

Exit Function
No_29th_Feb:
IsLeapYear = False
End Function

Public Function LeapYearInstance(Birthday As Date) As Date
LeapYearInstance = Format("Feb 29 " & Year(Birthday), "MMM dd yyyy")
End Function

Private Sub Main()
Form1.BorderStyle = 1
Form1.Show
End Sub



Rate Can calculate your age (in years and months), and even takes the LeapYear into account. Only uses a

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

''''''''Just Ctrl-C - Ctrl-V code into a new project
''''''''Add a Label1, Label2, Text1, and Command1 and hit F5!


'==================Subs==================
'In Form

Option Explicit

Private Sub Command1_Click()
'***    'You need to set BDay because it is the Pre-Formatted Birthdate,
        'whereas Text1 contains the String version of the Date, which is
        'the required Type in the Age function
    If Text1 <> "" Then
        On Error GoTo Invalid
        BDay = Format(Text1, "MMM dd yyyy")
        
        If IsLeapYear(Year(BDay)) = True Then
            Text1.ForeColor = &HFF0000
            If BDay = LeapYearInstance(BDay) Then Text1.ForeColor = &HFF& 'Else Text1.ForeColor = &H0
        Else
            Text1.ForeColor = &H0
        End If
        
        Text1 = Format(BDay, "MMM dd yyyy")
'        If DateDiff("d", Date, BDay) > 0 Then
            'Birthday is some time in the future
            
'        Else
            Label2 = Age(Text1) & StrYear(Val(Age(Text1))) & Months & StrMonth(Months)
'        End If
    End If
    
Exit Sub
Invalid:
    MsgBox "You have entered an invalid date", vbExclamation
    Text1.SetFocus
End Sub

Private Function StrYear(yrs As Integer) As String
    If yrs = 1 Then StrYear = " Year and " Else StrYear = " Years and "
End Function

Private Function StrMonth(mnth As Integer) As String
    If mnth = 1 Then StrMonth = " Month old " Else StrMonth = " Months old"
End Function

Private Sub Form_Activate()
'Centre Form
    Me.Left = (Screen.Width / 2) - (Me.Width / 2)
    Me.Top = (Screen.Height / 2) - (Me.Height / 2)
    Me.Width = 3450
    Me.Height = 1785
    
    Label1.Left = 120
    Label1.Top = 120
    Label1.Width = 3135
    Label1.Height = 255
    
    Text1.Left = 120
    Text1.Top = 480
    Text1.Width = 1815
    Text1.Height = 285
    
    Label2.Left = 120
    Label2.Top = 960
    Label2.Width = 3135
    Label2.Height = 255
    
    Command1.Left = 2040
    Command1.Top = 360
    Command1.Width = 1215
    Command1.Height = 375
    
    
'Change Captions etc
    Command1.Default = True
    Me.Caption = "Age Calculator"
    Label1 = "Enter Birthday"
    Text1 = Format(Date, "MMM dd yyyy")
    Label2 = "0 Years and 0 Months old"
    Command1.Caption = "Calculate"
End Sub