Menghitung Umur

Fungsi Menghitung Waktu

---

» Publisher: Mustakin Caca | Post: 2/14/2006 | Click: 588

---

Print Page Favorites

Function cari_umur(TanggalAwal As Date, TanggalAkhir As Date) As String
On Error GoTo salah
Dim tahun As Long, bln As Integer, bulan As Integer, thn As Long
Dim Counter As Integer, hari As Integer

hari = Format(CDate(TanggalAwal), "d")
bln = Format(CDate(TanggalAwal), "m")
thn = Format(CDate(TanggalAwal), "yyyy")

Do Until (hari = Format(CDate(TanggalAkhir), "d") And _
bln = Format(CDate(TanggalAkhir), "mm") And _
thn = Format(CDate(TanggalAkhir), "yyyy"))
hari = hari + 1


If hari = Format(CDate(TanggalAwal), "d") Then
bulan = bulan + 1 'jumlah bulan
Counter = 0 'jumlah hari
If bulan = 12 Then
bulan = 0
tahun = tahun + 1 'jumlah tahun
End If
Else
Counter = Counter + 1
End If

If CDate(hari & "/" & bln & "/" & thn) = CDate(Trim(TanggalAkhir)) Then Exit Do
If bln = 1 And hari = 31 Then
bln = bln + 1: hari = 0
ElseIf bln = 2 And hari = 29 And thn Mod 4 = 0 Then
bln = bln + 1: hari = 0
ElseIf bln = 2 And hari = 28 And thn Mod 4 > 0 Then
bln = bln + 1: hari = 0
ElseIf bln = 3 And hari = 30 Then
bln = bln + 1: hari = 0
ElseIf bln = 4 And hari = 30 Then
bln = bln + 1: hari = 0
ElseIf bln = 5 And hari = 31 Then
bln = bln + 1: hari = 0
ElseIf bln = 6 And hari = 30 Then
bln = bln + 1: hari = 0
ElseIf bln = 7 And hari = 31 Then
bln = bln + 1: hari = 0
ElseIf bln = 8 And hari = 31 Then
bln = bln + 1: hari = 0
ElseIf bln = 9 And hari = 30 Then
bln = bln + 1: hari = 0
ElseIf bln = 10 And hari = 31 Then
bln = bln + 1: hari = 0
ElseIf bln = 11 And hari = 30 Then
bln = bln + 1: hari = 0
ElseIf bln = 12 And hari = 31 Then
bln = 1: thn = thn + 1: hari = 0
End If
Loop

cari_umur = Counter & " hari " & bulan & " bulan " & tahun & " tahun"
Exit Function
salah:
If Err.Number = 13 Then
MsgBox "format tanggal salah"
End If
End Function

Private Sub Command3_Click()
'Mulai tanggal - s/d tanggal
MsgBox cari_umur(CDate(Text1), CDate(Text2))
End Sub