Sebuah function dibuat oleh Kerry Westphal, seorang program manager yang bekerja pada team Access, berfungsi untuk menghasilkan penyebutan tanggal dan waktu yang lebih manusiawi ketimbang hanya angka-angka tanggal dan jam. Function tersebut bernama
ElapsedDays().
Aslinya terdapat di
sini.
Dengan menggunakan function ini, anda bisa "menyebut keterangan" sebuah tanggal atau waktu "dibandingkan" dengan tanggal dan waktu yang ditentukan. Misalnya terhadap waktu pertemuan, anda bisa menyebut bahwa saat ini (terhadap waktu pertemuan itu) "Tinggal 15 menit lagi" atau "Sudah 1 jam yang lalu".
Cukup mengasyikan, sehingga saya merasa perlu mengadaptasikannya ke dalam bahasa Indonesia, dan mengubah sedikit prosedur sehingga menjadi lebih fleksibel.
Anda bisa langsung copy paste function berikut ini. Copy semua saja ke dalam sebuah module standard.
Untuk menjalankannya cukup ketik: ElapsedDays(TgWkt1, TgWkt2)
TgWkt1 adalah tanggal/waktu (datetime) dari kejadian/event yg ingin diukur (misal: tanggal pertemuan)
TgWkt2 adalah tanggal/waktu sekarang (atau tanggal/waktu tertentu yg anda inginkan). Parameter ini opsional, jadi kalau tidak diisi akan menggunakan waktu sekarang (Now).
Semoga bermanfaat.
Option Compare Database
Dim DateTimeDue As Date
Function ElapsedDays( _
Optional DateTimeStart As Date, _
Optional DateTimeEnd As Date _
) As String
'*************************************************************
' Function ElapsedDays(dateTimeStart As Date) As String
' Returns the time elapsed from today in a friendly string like,
' "A day ago"
'
' Originally created by: Kerry Westphal, a program manager who works on the Access team
' Adapted and refine by: Haer Talib, Office Access MVP from Indonesia
'*************************************************************
Dim interval As Double, days As Variant
If IsNull(DateTimeStart) Then Exit Function
DateTimeDue = IIf(DateTimeEnd = 0, Now, DateTimeEnd)
days = DateTimeStart - DateTimeDue
Dim leapYearNow
Dim leapYearBefore
If WhenLeapYear() = 1 Then
leapYearNow = 366
leapYearBefore = 365
Else:
If WhenLeapYear() = 2 Then
leapYearNow = 365
leapYearBefore = 366
Else
leapYearNow = 365
leapYearBefore = 365
End If
End If
Select Case days
Case Is < -leapYearBefore
ElapsedDays = "Lebih dari setahun yang lalu"
Case -leapYearBefore To -MonthTime(5) + -MonthTime(4)
ElapsedDays = "Tahun lalu"
Case -MonthTime(5) + -MonthTime(4) To -MonthTime(4)
ElapsedDays = "Sudah sebulan yang lalu"
Case -MonthTime(4) To -28
ElapsedDays = "Sudah empat minggu yang lalu"
Case -28 To -21
ElapsedDays = "Sudah tiga minggu yang lalu"
Case -21 To -13
ElapsedDays = "Sudah dua minggu yang lalu"
Case -13 To -7
ElapsedDays = "Sudah seminggu yang lalu"
Case -7 To -6
ElapsedDays = "Sudah enam hari yang lalu"
Case -6 To -5
ElapsedDays = "Sudah lima hari yang lalu"
Case -5 To -4
ElapsedDays = "Sudah empat hari yang lalu"
Case -4 To -3
ElapsedDays = "Sudah tiga hari yang lalu"
Case -3 To -2
ElapsedDays = "Sudah dua hari yang lalu"
Case -2 To -1
ElapsedDays = "Kemarin lusa"
Case -1 To 0
ElapsedDays = "Sudah " & ElapsedTimeString(DateTimeStart) & " yang lalu"
Case 0 To 1
ElapsedDays = "Tinggal " & ElapsedTimeString(DateTimeStart) & " lagi"
Case 1 To 2
ElapsedDays = "Besok"
Case 2 To 3
ElapsedDays = "Lusa"
Case 3 To 4
ElapsedDays = "Tiga hari lagi"
Case 4 To 5
ElapsedDays = "Empat hari lagi"
Case 5 To 6
ElapsedDays = "Lima hari lagi"
Case 6 To 7
ElapsedDays = "Enam hari lagi"
Case 7 To 14
ElapsedDays = "Seminggu lagi"
Case 14 To 21
ElapsedDays = "Dua minggu lagi"
Case 21 To 28
ElapsedDays = "Tiga minggu lagi"
Case 28 To MonthTime(1)
ElapsedDays = "Empat minggu lagi"
Case MonthTime(1) To MonthTime(2) + MonthTime(1)
ElapsedDays = "Sebulan lagi"
Case MonthTime(2) + MonthTime(1) To MonthTime(3) + MonthTime(2) + MonthTime(1)
ElapsedDays = "Dua bulan lagi"
Case MonthTime(3) + MonthTime(2) + MonthTime(1) To leapYearNow
ElapsedDays = "Kurang dari setahun lagi"
Case Is > leapYearNow
ElapsedDays = "Lebih dari setahun lagi"
End Select
If ElapsedDays = "0 yang lalu" Or ElapsedDays = "Dalam 0" Then ElapsedDays = "Sekarang"
End Function
Function IsLeapYear()
Dim leap As Variant
leap = DatePart("yyyy", DateTimeDue)
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then IsLeapYear = 29 Else IsLeapYear = 28
End Function
Public Function WhenLeapYear()
Dim leap As Variant
leap = DatePart("yyyy", DateTimeDue)
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then
WhenLeapYear = 1
Exit Function
Else
leap = leap - 1
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then
WhenLeapYear = 2
Exit Function
Else:
WhenLeapYear = 3
End If
End If
End Function
Function MonthTime() _
As Variant
Dim month As Variant
Dim MonthTime1(5) As Variant
month = DatePart("m", DateTimeDue)
Select Case month
Case 1 'January
MonthTime1(1) = 31 'January
MonthTime1(2) = IsLeapYear() 'February
MonthTime1(3) = 31 'March
MonthTime1(4) = 31 'December
MonthTime1(5) = 30 'November
Case 2 ' February
MonthTime1(1) = IsLeapYear() 'February
MonthTime1(2) = 31 'March
MonthTime1(3) = 30 'April
MonthTime1(4) = 31 'January
MonthTime1(5) = 31 'December
Case 3 'March
MonthTime1(1) = 31 'March
MonthTime1(2) = 30 'April
MonthTime1(3) = 31 'May
MonthTime1(4) = IsLeapYear() ' February
MonthTime1(5) = 31 'January
Case 4 'April
MonthTime1(1) = 30 'April
MonthTime1(2) = 31 'May
MonthTime1(3) = 30 'June
MonthTime1(4) = 31 'March
MonthTime1(5) = IsLeapYear() ' February
Case 5 'May
MonthTime1(1) = 31 'May
MonthTime1(2) = 30 'June
MonthTime1(3) = 31 'July
MonthTime1(4) = 30 'April
MonthTime1(5) = 31 'March
Case 6 'June
MonthTime1(1) = 30 'June
MonthTime1(2) = 31 'July
MonthTime1(3) = 31 'August
MonthTime1(4) = 31 'May
MonthTime1(5) = 30 'April
Case 7 'July
MonthTime1(1) = 31 'July
MonthTime1(2) = 31 'August
MonthTime1(3) = 30 'September
MonthTime1(4) = 30 'June
MonthTime1(5) = 31 'May
Case 8 'August
MonthTime1(1) = 30 'August
MonthTime1(2) = 31 'September
MonthTime1(3) = 31 'October
MonthTime1(4) = 31 'July
MonthTime1(5) = 30 'June
Case 9 'September
MonthTime1(1) = 31 'September
MonthTime1(2) = 31 'October
MonthTime1(3) = 30 'November
MonthTime1(4) = 30 'August
MonthTime1(5) = 31 'July
Case 10 'October
MonthTime1(1) = 31 'October
MonthTime1(2) = 30 'November
MonthTime1(3) = 31 'December
MonthTime1(4) = 31 'September
MonthTime1(5) = 30 'August
Case 11 'November
MonthTime1(1) = 30 'November
MonthTime1(2) = 31 'December
MonthTime1(3) = 31 'January
MonthTime1(4) = 31 'October
MonthTime1(5) = 31 'September
Case 12 'December
MonthTime1(1) = 31 'December
MonthTime1(2) = 31 'January
MonthTime1(3) = IsLeapYear() 'February
MonthTime1(4) = 30 'November
MonthTime1(5) = 31 'October
End Select
MonthTime = MonthTime1
End Function
Function ElapsedTimeString( _
Optional DateTimeStart As Date _
) As String
'*************************************************************
' Returns the time elapsed between a starting Date/Time and
' an ending Date/Time formatted as a string that looks like
' this:
' "20 hours, 30 minutes".
'*************************************************************
Dim interval As Double, str As String, days As Variant
Dim hours As String, minutes As String, seconds As String
If IsNull(DateTimeStart) = True Then Exit Function
interval = DateTimeDue - DateTimeStart
hours = Format(interval, "h")
minutes = Format(interval, "n")
' Hours part of the string
str = str & IIf(hours = "0", "", _
hours & " jam")
str = str & IIf(hours = "0", "", _
IIf(minutes <> "0", ", ", " "))
' Minutes part of the string
str = str & IIf(minutes = "0", "", _
minutes & " menit")
ElapsedTimeString = IIf(str = "", "0", str)
End Function
