Menghitung Umur Seseorang Dengan Lengkap (Hari, Bulan, Tahun)

Umumnya dikala orang bertanya kepada kita mengenai umur, kita hanya menyebutkan tahun nya saja, mungkin ribet kalau kita menyebutkan secara detailnya, namun hal itu tidak akan ribet lagi, dengan jadwal yang akan kita buat, kita dapat menghitung umur kita secara lengkap di visual basic, Baiklah berikut tutorialnya :

1. Jalankan VB dengan project Standar Exe

2. Tambahkan 1 Label, 1 command button, 1 text box, dan 1 Komponen DTPicker

Bagi anda yang belum tahu apa itu DTpicker dan cara menambahkannya, silahkan lihat disini :

Cara Menambahkan Tool Box Tambahan Di Visual Basic

3. Ubahlah tampilan dan propetiesnya, sehingga menyerupai ini :

Tool Box	Properties	Description
Form1	Start Up	Center Screen
Label 1	Caption	(Judul) MY AGE
Label 1	Font Size	24
Label 2	Caption	Today (Tanggal Hari Ini)
Label 3		Date Of Birth (Tanggal Lahir)
Label 4		(Kosong)
Command 1	Caption	My Age (Umur Saya)
Text 1	Text	(Kosong)
All	Font Size	10

4. Tulislah script berikut :

Function MenghitungUmur(dateOfBird As Date, fromData As Date) As String

Dim dateNow As Date

Dim tgl As Date

Dim tgl1 As Date

Dim years As Long

Dim months As Long

Dim days As Long

Dim yearWord As String

Dim monthWord As String

Dim dayWord As String

dateNow = fromData

tgl = dateOfBird

'Menghitung Selisih Tahun

years = DateDiff("yyyy", tgl, dateNow)

If Month(tgl) > Month(dateNow) Then

years = years - 1

ElseIf Month(tgl) = Month(dateNow) And Day(tgl) > Day(dateNow) Then

years = years - 1

ElseIf Month(tgl) = Month(dateNow) And Day(tgl) = Day(dateNow) Then

GoTo finally ' kalau bulan dan tanggal sama maka perhitungan selesai

End If

'Menghitung Selisih Bulan

tgl = DateAdd("yyyy", years, tgl)

months = DateDiff("m", tgl, dateNow)

If Day(tgl) > Day(dateNow) Then

months = months - 1

ElseIf Month(tgl) = Month(dateNow) And Day(tgl) >= Day(dateNow) Then

months = months - 1

End If

tgl = DateAdd("m", months, tgl)

'Menghitung Selisih Hari

days = DateDiff("d", tgl, dateNow)

finally:

yearWord = IIf(years = 0, "", years & " Tahun ")

monthWord = IIf(months = 0, "", months & " Bulan ")

dayWord = IIf(days = 0, "", days & " Hari ")

MenghitungUmur = yearWord & monthWord & dayWord

MenghitungUmur = Trim(MenghitungUmur)

End Function

Private Sub Command1_Click()

'Pesan Jika tanggal lahir sama dengan tanggal hari ini dan

'Tanggal Lahir lebih dari tanggal hari ini

if DTPicker1.Value = Text1.Text Or DTPicker1.Value > Text1.Text Then

MsgBox "Isi Data Dengan Benar", vbInformation, "Routeros Mikrotik"

Else

Dim strMsg As String

strMsg = "Umur : " & MenghitungUmur(DTPicker1.Value, Text1.Text)

MsgBox strMsg, vbInformation

End If

End Sub

Private Sub Form_Load()

'Isi Text dari text1 ialah tanggal hari ini / tanggal dikala jadwal di jalankan

Text1.Text = Format(Now, "DD/MM/YY")

End Sub

Function MenghitungUmur(dateOfBird As Date, fromData As Date) As String     Dim dateNow As Date     Dim tgl As Date     Dim tgl1 As Date     Dim years As Long     Dim months As Long     Dim days As Long     Dim yearWord As String     Dim monthWord As String     Dim dayWord As String     dateNow = fromData     tgl = dateOfBird     'Menghitung Selisih Tahun     years = DateDiff("yyyy", tgl, dateNow)     If Month(tgl) > Month(dateNow) Then         years = years - 1     ElseIf Month(tgl) = Month(dateNow) And Day(tgl) > Day(dateNow) Then         years = years - 1     ElseIf Month(tgl) = Month(dateNow) And Day(tgl) = Day(dateNow) Then         GoTo finally ' kalau bulan dan tanggal sama maka perhitungan selesai     End If     'Menghitung Selisih Bulan     tgl = DateAdd("yyyy", years, tgl)     months = DateDiff("m", tgl, dateNow)     If Day(tgl) > Day(dateNow) Then         months = months - 1     ElseIf Month(tgl) = Month(dateNow) And Day(tgl) >= Day(dateNow) Then         months = months - 1     End If     tgl = DateAdd("m", months, tgl)     'Menghitung Selisih Hari     days = DateDiff("d", tgl, dateNow) finally:     yearWord = IIf(years = 0, "", years & " Tahun ")     monthWord = IIf(months = 0, "", months & " Bulan ")     dayWord = IIf(days = 0, "", days & " Hari ")     MenghitungUmur = yearWord & monthWord & dayWord     MenghitungUmur = Trim(MenghitungUmur) End Function Private Sub Command1_Click() 'Pesan Jika tanggal lahir sama dengan tanggal hari ini dan 'Tanggal Lahir lebih dari tanggal hari ini if DTPicker1.Value = Text1.Text Or DTPicker1.Value > Text1.Text Then MsgBox "Isi Data Dengan Benar", vbInformation, "Routeros Mikrotik" Else     Dim strMsg As String     strMsg = "Umur : " & MenghitungUmur(DTPicker1.Value, Text1.Text)     MsgBox strMsg, vbInformation End If End Sub  Private Sub Form_Load() 'Isi Text dari text1 ialah tanggal hari ini / tanggal dikala jadwal di jalankan Text1.Text = Format(Now, "DD/MM/YY") End Sub

5. Jika sudah silahkan jalankan program