Fungsi Menghitung Waktu

Fungsi berikut digunakan untuk menghitung waktu/tanggal secara lebih detail. Dimana fungsi berikut dapat menampilkan Hari Bulan dan Tahun dari hasil proses.

Fungsi tersebut juga dapat digunakan dalam menghitung tanggal lahir seseorang, hanya dengan memasukan 2 paramter untuk diproses.

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

Posted in: Visual Basic