Kalau dulu saya pernah posting cara membuat fungsi terbilang di Microsoft Excell disini, kali ini saya pengen catat membuat fungsi terbilang di Microsoft Access, karena emang Microsoft tidak menyediakan fungsi terbilang. keduanya sama aja sih, tapi menurut saya Access lebih lancar dibandingkan Excell kalau bicara olah mengolah data, pengalaman pake Excell sering lemot-lemot, beda dengan Access yang lancar jaya walau data sudah mencapai ribuan.
Cara pertama
Copykan kode ini pada modul kemudian jangan lupa disimpan ya :)
Public Function Terbilang(x As Currency)terima kasih buat http://marsyaputri.blogspot.com/
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency
Dim ribu As Currency
Dim satu As Currency
Dim sen As Currency
Dim baca As String
If x > 1000000000000# Then
Terbilang = "<>"
Exit Function
End If
'Jika x adalah 0, maka dibaca sebagai 0
If x = 0 Then
baca = angka(0, 1)
Else
'Pisah masing-masing bagian untuk triliun, milyar, juta, ribu, rupiah, dan sen
triliun = Int(x * 0.001 ^ 4)
milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
sen = Int((x - Int(x)) * 100)
'Baca bagian triliun dan ditambah akhiran triliun
If triliun > 0 Then
baca = ratus(triliun, 5) + "triliun "
End If
'Baca bagian milyar dan ditambah akhiran milyar
If milyar > 0 Then
baca = ratus(milyar, 4) + "milyar "
End If
'Baca bagian juta dan ditambah akhiran juta
If juta > 0 Then
baca = baca + ratus(juta, 3) + "juta "
End If
'Baca bagian ribu dan ditambah akhiran ribu
If ribu > 0 Then
baca = baca + ratus(ribu, 2) + "ribu "
End If
'Baca bagian rupiah dan ditambah akhiran rupiah
If satu > 0 Then
baca = baca + ratus(satu, 1) + "rupiah "
Else
baca = baca + "rupiah"
End If
'Baca bagian sen dan ditambah akhiran sen
If sen > 0 Then
baca = baca + ratus(sen, 0) + "sen"
End If
End If
Terbilang = UCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function
Function ratus(x As Currency, Posisi As Integer) As String
Dim a100 As Integer, a10 As Integer, a1 As Integer
Dim baca As String
a100 = Int(x * 0.01)
a10 = Int((x - a100 * 100) * 0.1)
a1 = Int(x - a100 * 100 - a10 * 10)
'Baca Bagian Ratus
If a100 = 1 Then
baca = "Seratus "
Else
If a100 > 0 Then
baca = angka(a100, Posisi) + "ratus "
End If
End If
'Baca Bagian Puluh dan Satuan
If a10 = 1 Then
baca = baca + angka(a10 * 10 + a1, Posisi)
Else
If a10 > 0 Then
baca = baca + angka(a10, Posisi) + "puluh "
End If
If a1 > 0 Then
baca = baca + angka(a1, Posisi)
End If
End If
ratus = baca
End Function
Function angka(x As Integer, Posisi As Integer)
Select Case x
Case 0: angka = "Nol"
Case 1:
If Posisi <= 1 Or Posisi > 2 Then
angka = "Satu "
Else
angka = "Se"
End If
Case 2: angka = "Dua "
Case 3: angka = "Tiga "
Case 4: angka = "Empat "
Case 5: angka = "Lima "
Case 6: angka = "Enam "
Case 7: angka = "Tujuh "
Case 8: angka = "Delapan "
Case 9: angka = "Sembilan "
Case 10: angka = "Sepuluh "
Case 11: angka = "Sebelas "
Case 12: angka = "Duabelas "
Case 13: angka = "Tigabelas "
Case 14: angka = "Empatbelas "
Case 15: angka = "Limabelas "
Case 16: angka = "Enambelas "
Case 17: angka = "Tujuhbelas "
Case 18: angka = "Delapanbelas "
Case 19: angka = "Sembilanbelas "
End Select
End Function
Cara kedua
Download file ini, lalau buka, tinggal copy modulnya dan paste langsung ke Navigate Pane file punyamu(menu yang ada di sisi kiri)
Kemudian cara pakainya keduanya sama, yaitu seperti penjelasan di atas pada saat masuk menu Desain Query, klik kanan Field, lalu pilih menu Builder, di Menu Expression Builder, pilih Function, kalau sudah dapet rumusnya pilih juga tabel dan kolom apa yang akan kita baca terbilangnya.
Update 09 Oktober 2013 ternyata setelah dicoba-coba ada eror seribu malah dibaca satu ribu, mungkin ada yang bisa memperbaiki?
catetan : ngitung tanggal jatuh tempo denga rumus EDATE
ReplyDelete