Aiska Blog

buat kamu yang pengen bikin fungsi bilangan untuk accounting atau lain sebagainya ini ada sedikit kode yang aku tulis menggunakan VB6 (actually I've upgrade it into VB.net). aku bikin fungsi ini 2 tahun yang lalu mungkin bisa bermanfaat buat temen-temen

here the code:
[code]
Option Explicit
' This Code Written By Aiska Hendra

Public Function Terbilang(Angka As Double, Optional Rupiah As Boolean = True) As String
On Error GoTo Error
Dim Desimal As Double
Dim sDesimal As String
Dim Koma As String
Dim M As Variant
Dim sAngka As String
Dim locttk As Integer
Dim jAngka As Integer
Dim bilangan As String

Desimal = 0
Koma = ""
sDesimal = ""
Angka = Abs(Angka)
Angka = Round(Angka, 2)
sAngka = Trim(Str(Angka))
jAngka = Len(sAngka)
locttk = InStrRev(sAngka, ".")
If locttk > 0 Then
sDesimal = Right(sAngka, jAngka - locttk)
If Len(sDesimal) = 1 Then Desimal = Val(sDesimal) * 10 Else Desimal = Val(sDesimal)
Angka = Val(Left(sAngka, locttk - 1))
End If

If jAngka <= 0 Then Exit Function 'kalau kosong keluar
If Angka <= 0 Then Terbilang = "": Exit Function 'kalau kosong keluar
If Angka >= 1E+15 Then Terbilang = "Error !!!": Exit Function

If Desimal <> 0 Then
bilangan = Triliunan(Angka)
sDesimal = "Koma " & Triliunan(Desimal)
bilangan = bilangan & sDesimal
Else
bilangan = Triliunan(Angka)
End If

If Rupiah Then
If bilangan <> "" Then Terbilang = bilangan & "Rupiah"
Else
Terbilang = bilangan
End If
Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Terbilang", "Accounting"
Resume Next
End Function

Private Function Satuan(satAngka As Double) As String
On Error GoTo Error
Select Case satAngka
Case 0:
Satuan = ""
Case 1:
Satuan = "Satu "
Case 2:
Satuan = "Dua "
Case 3:
Satuan = "Tiga "
Case 4:
Satuan = "Empat "
Case 5:
Satuan = "Lima "
Case 6:
Satuan = "Enam "
Case 7:
Satuan = "Tujuh "
Case 8:
Satuan = "Delapan "
Case 9:
Satuan = "Sembilan "
Case 10:
Satuan = "Sepuluh "
Case 11:
Satuan = "Sebelas "
End Select

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Satuan", "Accounting"
Resume Next
End Function

Private Function Puluhan(pulAngka As Double) As String
On Error GoTo Error
If pulAngka < 12 Then
Puluhan = Satuan(pulAngka)
ElseIf Left(pulAngka, 1) = 1 Then
Puluhan = Satuan(Right(pulAngka, 1)) & "Belas "
Else
Puluhan = Satuan(Left(pulAngka, 1)) & "Puluh " & Satuan(Right(pulAngka, 1))
End If
Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Puluhan", "Accounting"
Resume Next
End Function

Private Function Ratusan(ratAngka As Double) As String
On Error GoTo Error
Ratusan = ""
If ratAngka = 0 Then
Exit Function
ElseIf ratAngka >= 100 And ratAngka < 200 Then
Ratusan = "Seratus "
ElseIf ratAngka >= 200 And ratAngka < 1000 Then
Ratusan = Satuan(Left(ratAngka, 1)) & "Ratus "
End If
Ratusan = Ratusan & Puluhan(Val(Right(ratAngka, 2)))

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Ratusan", "Accounting"
Resume Next
End Function

Private Function Ribuan(ribAngka As Double) As String
On Error GoTo Error
Ribuan = ""
If ribAngka = 0 Then
Exit Function
ElseIf ribAngka >= 1000 And ribAngka < 2000 Then
Ribuan = "Seribu "
ElseIf ribAngka >= 2000 And ribAngka < 10000 Then
Ribuan = Satuan(Left(ribAngka, 1)) & "Ribu "
ElseIf ribAngka >= 10000 And ribAngka < 100000 Then
Ribuan = Puluhan(Left(ribAngka, 2)) & "Ribu "
ElseIf ribAngka >= 10000 And ribAngka < 1000000 Then
Ribuan = Ratusan(Left(ribAngka, 3)) & "Ribu "
End If
Ribuan = Ribuan & Ratusan(Right(ribAngka, 3))

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Ribuan", "Accounting"
Resume Next
End Function

Private Function Jutaan(jutAngka As Double) As String
On Error GoTo Error
Jutaan = ""
If jutAngka = 0 Then
Exit Function
ElseIf jutAngka >= 1000000 And jutAngka < 10000000 Then
Jutaan = Satuan(Left(jutAngka, 1)) & "Juta "
ElseIf jutAngka >= 10000000 And jutAngka < 100000000 Then
Jutaan = Puluhan(Left(jutAngka, 2)) & "Juta "
ElseIf jutAngka >= 100000000 And jutAngka < 1000000000 Then
Jutaan = Ratusan(Left(jutAngka, 3)) & "Juta "
End If
Jutaan = Jutaan & Ribuan(Right(jutAngka, 6))

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Jutaan", "Accounting"
Resume Next
End Function

Private Function Milyaran(milAngka As Double) As String
On Error GoTo Error
Milyaran = ""
If milAngka = 0 Then
Exit Function
ElseIf milAngka >= 1000000000 And milAngka < 10000000000# Then
Milyaran = Satuan(Left(milAngka, 1)) & "Milyar "
ElseIf milAngka >= 10000000000# And milAngka < 100000000000# Then
Milyaran = Puluhan(Left(milAngka, 2)) & "Milyar "
ElseIf milAngka >= 100000000000# And milAngka < 1000000000000# Then
Milyaran = Ratusan(Left(milAngka, 3)) & "Milyar "
ElseIf milAngka >= 100000000000000# And milAngka < 1E+15 Then
Milyaran = Jutaan(Left(milAngka, 6)) & "Milyar "
End If

Milyaran = Milyaran & Jutaan(Right(milAngka, 9))

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Milyaran", "Accounting"
Resume Next
End Function

Private Function Triliunan(trilAngka As Double) As String
On Error GoTo Error
Triliunan = ""
If trilAngka = 0 Then
Exit Function
ElseIf trilAngka >= 1000000000000# And trilAngka < 10000000000000# Then
Triliunan = Satuan(Left(trilAngka, 1)) & "Triliun "
ElseIf trilAngka >= 10000000000000# And trilAngka < 100000000000000# Then
Triliunan = Puluhan(Left(trilAngka, 2)) & "Triliun "
ElseIf trilAngka >= 100000000000000# And trilAngka < 1E+15 Then
Triliunan = Ratusan(Left(trilAngka, 3)) & "Triliun "
ElseIf trilAngka >= 1E+17 And trilAngka < 1E+18 Then
Triliunan = Jutaan(Left(trilAngka, 6)) & "Triliun "
ElseIf trilAngka >= 1E+20 And trilAngka < 1E+21 Then
Triliunan = Milyaran(Left(trilAngka, 9)) & "Triliun "
End If

Triliunan = Triliunan & Milyaran(Right(trilAngka, 12))

Exit Function
Error:
If Err.Number > 0 Then CatatError Err, "Triliunan", "Accounting"
Resume Next
End Function

untuk memanggil kode cukup masukkan perintah
textbox1.text = Terbilang(2500, true)
maka hasil yang akan keluar adalah

Dua Ribu Lima Ratus Rupiah

variabel true diatas adalah untuk menambahkan kata rupiah pada teks jika anda tidak ingin ingin menambahkan rupiah maka diset menjadi false

Saya harap kode ini bisa membantu anda