Waktu menggunakan microsoft access, saya kesulitan menemukan program yang bagus dalam membuat terbilang pada kwitansi.
Saat uji coba, program program yang ada di internet foxpro dll, tidak sesuai dengan kaidah bahasa indonesia.
Kemudian saya temukan program terbilang English, yang ternyata ada pada Help file microsoft access.
Wow, hebat, menggunakan metode recursif, yaitu program yang memanggil dirinya sendiri. Sehingga pemograman sederhana dan kecepatan tinggi.
dibawah ini program terbilang bahasa indonesia serta program aslinya bahasa English,
saya lakukan modifikasi sedikit dari program aslinya
taruh textbox untuk terbilang pada form
lalu klik-klik propertynya, lalu isikan data source
=" (# " & ConvertCurrencyToIndonesia(Int([rupiahangkanya])) & " #)"
atau
=" (# " & ConvertCurrencyToEnglish(Int([dollarangkanya])) & " #)"
rupiahangkanya atau dollarangkanya adalah nama textbox yang berisi angka yang hendak dibuat
terbilang, bisa juga dari hasil penjumlahan(misalnya textbox [totalrupiah]
-------------------------------------
Option Compare Database
Option Explicit
Function ConvertCurrencyToIndonesia(ByVal Angkanya)
Dim temp
Dim Rupiahnya, Sennya
Dim DecimalPlace, Count
ReDim place(9) As String
' untuk nilai count=count+1, Angkanya dibagi atas 3 digit
place(2) = "RIBU "
place(3) = "JUTA "
place(4) = "MILYAR "
place(5) = "TRILYUN "
' ubah jadi string , dan hilangkan spasi.
Angkanya = Trim(Str(Angkanya))
' cari sen.
DecimalPlace = InStr(Angkanya, ".")
' bila ketemu sen...
If DecimalPlace > 0 Then
' ubah ke sen
temp = left(Mid(Angkanya, DecimalPlace + 1) & "00", 2)
Sennya = ConvertPuluhan(temp)
' buang sen dari Angkanya.
Angkanya = Trim(left(Angkanya, DecimalPlace - 1))
End If
Count = 1
' ini yang repot, soalnya seribu bukannya satu ribu
Do While Angkanya <> ""
' jadi pakai if dengan count=2 dan angkanya=1 saja
' tapi bila angkanya diatas 999 trilyun harus tambah lagi if
' untuk count = 7
If Right(Angkanya, 3) = 1 And Count = 2 Then
temp = "SE"
Else
' Ubah setiap 3 digit ke terbilang di Indonesia
temp = ConvertRatusan(Right(Angkanya, 3))
End If
' ini dia hasilnya.....
If temp <> "" Then Rupiahnya = temp & place(Count) & Rupiahnya
If Len(Angkanya) > 3 Then
' buang 3 angka terakhir dari Angkanya dan count boleh tambah.
Angkanya = left(Angkanya, Len(Angkanya) - 3)
Else
Angkanya = ""
End If
Count = Count + 1
Loop
' kosongkan nilai rupiahnya.
Select Case Rupiahnya
Case ""
Rupiahnya = "NIL RUPIAH "
Case "One"
Rupiahnya = "SATU RUPIAH"
Case Else
Rupiahnya = Rupiahnya & " RUPIAH"
End Select
' kosongkan nilai sennya.
Select Case Sennya
Case ""
Sennya = " "
Case "One"
Sennya = "SATU SEN"
Case Else
Sennya = " DAN " & Sennya & " SEN"
End Select
ConvertCurrencyToIndonesia = Rupiahnya & Sennya
End Function
Private Function ConvertSatuan(ByVal Satuannya)
Select Case Val(Satuannya)
Case 1: ConvertSatuan = "SATU "
Case 2: ConvertSatuan = "DUA "
Case 3: ConvertSatuan = "TIGA "
Case 4: ConvertSatuan = "EMPAT "
Case 5: ConvertSatuan = "LIMA "
Case 6: ConvertSatuan = "ENAM "
Case 7: ConvertSatuan = "TUJUH "
Case 8: ConvertSatuan = "DELAPAN "
Case 9: ConvertSatuan = "SEMBILAN "
Case Else: ConvertSatuan = ""
End Select
End Function
Private Function ConvertRatusan(ByVal Angkanya)
Dim Result As String
' Exit if there is nothing to convert.
If Val(Angkanya) = 0 Then Exit Function
' Append leading zeros to number.
Angkanya = Right("000" & Angkanya, 3)
' Do we have a hundreds place digit to convert?
If left(Angkanya, 1) <> "0" Then
Result = ConvertSeratus(left(Angkanya, 1)) & "RATUS" & Chr$(32)
End If
' Do we have a tens place digit to convert?
If Mid(Angkanya, 2, 1) <> "0" Then
Result = Result & ConvertPuluhan(Mid(Angkanya, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertSatuan(Mid(Angkanya, 3))
End If
ConvertRatusan = Result
End Function
Private Function ConvertPuluhan(ByVal Puluhannya)
Dim Result As String
' untuk bilangan sebelas,, kalau english itu juga ada dua
' eleventh dan twelve
If Val(left(Puluhannya, 1)) = 1 Then
Select Case Val(Puluhannya)
Case 10: Result = "SEPULUH "
Case 11: Result = "SEBELAS "
Case 12: Result = "DUA BELAS "
Case 13: Result = "TIGA BELAS "
Case 14: Result = "EMPAT BELAS "
Case 15: Result = "LIMA BELAS "
Case 16: Result = "ENAM BELAS "
Case 17: Result = "TUJUH BELAS "
Case 18: Result = "DELAPAN BELAS "
Case 19: Result = "SEMBILAN BELAS "
Case Else
End Select
Else
' .. juga untuk sisanya.
Select Case Val(left(Puluhannya, 1))
Case 2: Result = "DUA PULUH "
Case 3: Result = "TIGA PULUH "
Case 4: Result = "EMPAT PULUH "
Case 5: Result = "LIMA PULUH "
Case 6: Result = "ENAM PULUH "
Case 7: Result = "TUJUH PULUH "
Case 8: Result = "DELAPAN PULUH "
Case 9: Result = "SEMBILAN PULUH "
Case Else
End Select
' tambahkan dengan satuannya.
Result = Result & ConvertSatuan(Right(Puluhannya, 1))
End If
ConvertPuluhan = Result
End Function
Private Function ConvertSeratus(ByVal Ratusannya)
' ini untuk ratusan dimana satu ratus diganti seratus
Select Case Val(Ratusannya)
Case 1: ConvertSeratus = "SE"
Case 2: ConvertSeratus = "DUA "
Case 3: ConvertSeratus = "TIGA "
Case 4: ConvertSeratus = "EMPAT "
Case 5: ConvertSeratus = "LIMA "
Case 6: ConvertSeratus = "ENAM "
Case 7: ConvertSeratus = "TUJUH "
Case 8: ConvertSeratus = "DELAPAN "
Case 9: ConvertSeratus = "SEMBILAN "
Case Else: ConvertSeratus = ""
End Select
End Function
---------------------
Option Compare Database
Option Explicit
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim dollars, Cents
Dim DecimalPlace, Count
ReDim place(9) As String
place(2) = " Thousand "
place(3) = " Million "
place(4) = " Billion "
place(5) = " Trillion "
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")
' If we find decimal place...
If DecimalPlace > 0 Then
' Convert cents
Temp = left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Cents = ConvertTens(Temp)
' Strip off cents from remainder to convert.
MyNumber = Trim(left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
' Convert last 3 digits of MyNumber to English dollars.
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then dollars = Temp & place(Count) & dollars
If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
' Clean up dollars.
Select Case dollars
Case ""
dollars = "No"
Case "One"
dollars = "One"
End Select
' Clean up cents.
Select Case Cents
Case ""
Cents = " And No Cents"
Case "One"
Cents = " And One Cent"
Case Else
Cents = " And " & Cents & " Cents"
End Select
ConvertCurrencyToEnglish = dollars & Cents
End Function
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)
' Do we have a hundreds place digit to convert?
If left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(left(MyNumber, 1)) & " Hundred "
End If
' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
Dim Result As String
' Is value between 10 and 19?
If Val(left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(left(MyTens, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If
ConvertTens = Result
End Function
---------------------
selesai
Sekedar memindahkan catatan dari yahoo groups ke blog saya
Wassalam,
budi
Saat uji coba, program program yang ada di internet foxpro dll, tidak sesuai dengan kaidah bahasa indonesia.
Kemudian saya temukan program terbilang English, yang ternyata ada pada Help file microsoft access.
Wow, hebat, menggunakan metode recursif, yaitu program yang memanggil dirinya sendiri. Sehingga pemograman sederhana dan kecepatan tinggi.
dibawah ini program terbilang bahasa indonesia serta program aslinya bahasa English,
saya lakukan modifikasi sedikit dari program aslinya
taruh textbox untuk terbilang pada form
lalu klik-klik propertynya, lalu isikan data source
=" (# " & ConvertCurrencyToIndonesia(Int([rupiahangkanya])) & " #)"
atau
=" (# " & ConvertCurrencyToEnglish(Int([dollarangkanya])) & " #)"
rupiahangkanya atau dollarangkanya adalah nama textbox yang berisi angka yang hendak dibuat
terbilang, bisa juga dari hasil penjumlahan(misalnya textbox [totalrupiah]
-------------------------------------
Option Compare Database
Option Explicit
Function ConvertCurrencyToIndonesia(ByVal Angkanya)
Dim temp
Dim Rupiahnya, Sennya
Dim DecimalPlace, Count
ReDim place(9) As String
' untuk nilai count=count+1, Angkanya dibagi atas 3 digit
place(2) = "RIBU "
place(3) = "JUTA "
place(4) = "MILYAR "
place(5) = "TRILYUN "
' ubah jadi string , dan hilangkan spasi.
Angkanya = Trim(Str(Angkanya))
' cari sen.
DecimalPlace = InStr(Angkanya, ".")
' bila ketemu sen...
If DecimalPlace > 0 Then
' ubah ke sen
temp = left(Mid(Angkanya, DecimalPlace + 1) & "00", 2)
Sennya = ConvertPuluhan(temp)
' buang sen dari Angkanya.
Angkanya = Trim(left(Angkanya, DecimalPlace - 1))
End If
Count = 1
' ini yang repot, soalnya seribu bukannya satu ribu
Do While Angkanya <> ""
' jadi pakai if dengan count=2 dan angkanya=1 saja
' tapi bila angkanya diatas 999 trilyun harus tambah lagi if
' untuk count = 7
If Right(Angkanya, 3) = 1 And Count = 2 Then
temp = "SE"
Else
' Ubah setiap 3 digit ke terbilang di Indonesia
temp = ConvertRatusan(Right(Angkanya, 3))
End If
' ini dia hasilnya.....
If temp <> "" Then Rupiahnya = temp & place(Count) & Rupiahnya
If Len(Angkanya) > 3 Then
' buang 3 angka terakhir dari Angkanya dan count boleh tambah.
Angkanya = left(Angkanya, Len(Angkanya) - 3)
Else
Angkanya = ""
End If
Count = Count + 1
Loop
' kosongkan nilai rupiahnya.
Select Case Rupiahnya
Case ""
Rupiahnya = "NIL RUPIAH "
Case "One"
Rupiahnya = "SATU RUPIAH"
Case Else
Rupiahnya = Rupiahnya & " RUPIAH"
End Select
' kosongkan nilai sennya.
Select Case Sennya
Case ""
Sennya = " "
Case "One"
Sennya = "SATU SEN"
Case Else
Sennya = " DAN " & Sennya & " SEN"
End Select
ConvertCurrencyToIndonesia = Rupiahnya & Sennya
End Function
Private Function ConvertSatuan(ByVal Satuannya)
Select Case Val(Satuannya)
Case 1: ConvertSatuan = "SATU "
Case 2: ConvertSatuan = "DUA "
Case 3: ConvertSatuan = "TIGA "
Case 4: ConvertSatuan = "EMPAT "
Case 5: ConvertSatuan = "LIMA "
Case 6: ConvertSatuan = "ENAM "
Case 7: ConvertSatuan = "TUJUH "
Case 8: ConvertSatuan = "DELAPAN "
Case 9: ConvertSatuan = "SEMBILAN "
Case Else: ConvertSatuan = ""
End Select
End Function
Private Function ConvertRatusan(ByVal Angkanya)
Dim Result As String
' Exit if there is nothing to convert.
If Val(Angkanya) = 0 Then Exit Function
' Append leading zeros to number.
Angkanya = Right("000" & Angkanya, 3)
' Do we have a hundreds place digit to convert?
If left(Angkanya, 1) <> "0" Then
Result = ConvertSeratus(left(Angkanya, 1)) & "RATUS" & Chr$(32)
End If
' Do we have a tens place digit to convert?
If Mid(Angkanya, 2, 1) <> "0" Then
Result = Result & ConvertPuluhan(Mid(Angkanya, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertSatuan(Mid(Angkanya, 3))
End If
ConvertRatusan = Result
End Function
Private Function ConvertPuluhan(ByVal Puluhannya)
Dim Result As String
' untuk bilangan sebelas,, kalau english itu juga ada dua
' eleventh dan twelve
If Val(left(Puluhannya, 1)) = 1 Then
Select Case Val(Puluhannya)
Case 10: Result = "SEPULUH "
Case 11: Result = "SEBELAS "
Case 12: Result = "DUA BELAS "
Case 13: Result = "TIGA BELAS "
Case 14: Result = "EMPAT BELAS "
Case 15: Result = "LIMA BELAS "
Case 16: Result = "ENAM BELAS "
Case 17: Result = "TUJUH BELAS "
Case 18: Result = "DELAPAN BELAS "
Case 19: Result = "SEMBILAN BELAS "
Case Else
End Select
Else
' .. juga untuk sisanya.
Select Case Val(left(Puluhannya, 1))
Case 2: Result = "DUA PULUH "
Case 3: Result = "TIGA PULUH "
Case 4: Result = "EMPAT PULUH "
Case 5: Result = "LIMA PULUH "
Case 6: Result = "ENAM PULUH "
Case 7: Result = "TUJUH PULUH "
Case 8: Result = "DELAPAN PULUH "
Case 9: Result = "SEMBILAN PULUH "
Case Else
End Select
' tambahkan dengan satuannya.
Result = Result & ConvertSatuan(Right(Puluhannya, 1))
End If
ConvertPuluhan = Result
End Function
Private Function ConvertSeratus(ByVal Ratusannya)
' ini untuk ratusan dimana satu ratus diganti seratus
Select Case Val(Ratusannya)
Case 1: ConvertSeratus = "SE"
Case 2: ConvertSeratus = "DUA "
Case 3: ConvertSeratus = "TIGA "
Case 4: ConvertSeratus = "EMPAT "
Case 5: ConvertSeratus = "LIMA "
Case 6: ConvertSeratus = "ENAM "
Case 7: ConvertSeratus = "TUJUH "
Case 8: ConvertSeratus = "DELAPAN "
Case 9: ConvertSeratus = "SEMBILAN "
Case Else: ConvertSeratus = ""
End Select
End Function
---------------------
Option Compare Database
Option Explicit
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim dollars, Cents
Dim DecimalPlace, Count
ReDim place(9) As String
place(2) = " Thousand "
place(3) = " Million "
place(4) = " Billion "
place(5) = " Trillion "
' Convert MyNumber to a string, trimming extra spaces.
MyNumber = Trim(Str(MyNumber))
' Find decimal place.
DecimalPlace = InStr(MyNumber, ".")
' If we find decimal place...
If DecimalPlace > 0 Then
' Convert cents
Temp = left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Cents = ConvertTens(Temp)
' Strip off cents from remainder to convert.
MyNumber = Trim(left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
' Convert last 3 digits of MyNumber to English dollars.
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then dollars = Temp & place(Count) & dollars
If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
' Clean up dollars.
Select Case dollars
Case ""
dollars = "No"
Case "One"
dollars = "One"
End Select
' Clean up cents.
Select Case Cents
Case ""
Cents = " And No Cents"
Case "One"
Cents = " And One Cent"
Case Else
Cents = " And " & Cents & " Cents"
End Select
ConvertCurrencyToEnglish = dollars & Cents
End Function
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)
' Do we have a hundreds place digit to convert?
If left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(left(MyNumber, 1)) & " Hundred "
End If
' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
Dim Result As String
' Is value between 10 and 19?
If Val(left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(left(MyTens, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
' Convert ones place digit.
Result = Result & ConvertDigit(Right(MyTens, 1))
End If
ConvertTens = Result
End Function
---------------------
selesai
Sekedar memindahkan catatan dari yahoo groups ke blog saya
Wassalam,
budi
Komentar