Kamis, 17 November 2011

[VB 6.0] Mengkonversi atau Mengubah bilangan ke teks


Pada program database atau penghitungan,pengonversi bilangan ke kata atau teks itu sangat penting untuk mempermudah user atau pengguna membaca suatu angka,tentu akan merepotkan dan memusingkan jika user membaca 19876879 (Sembilan Belas Juta Delapan Ratus Tujuh Puluh Enam Ribu Delapan Ratus Tujuh Puluh Sembilan) seperti ini bukan??

untuk yang ingin mengetahuinya,berikut cara mengkonversi atau mengubah nilai bilangan atau angka ke format teks dengan VB 6.0

Function ubah(ByVal n As Currency) As String 'maksimal bilangan 2.147.483.647
  Dim satuan As Variant
  satuan = Array("", "Satu", "Dua", "Tiga", "Empat", "Lima", "Enam", "Tujuh", "Delapan", "Sembilan", "Sepuluh", "Sebelas")
  Select Case n 'keadaan
    Case 0 To 11
        ubah = " " + satuan(Fix(n))
    Case 12 To 19
        ubah = ubah(n Mod 10) + " Belas"
    Case 20 To 99
        ubah = ubah(Fix(n / 10)) + " Puluh" + ubah(n Mod 10)
    Case 100 To 199
        ubah = " Seratus" + ubah(n - 100)
    Case 200 To 999
        ubah = ubah(Fix(n / 100)) + " Ratus" + ubah(n Mod 100)
    Case 1000 To 1999
        ubah = " Seribu" + ubah(n - 1000)
    Case 2000 To 999999
        ubah = ubah(Fix(n / 1000)) + " Ribu" + ubah(n Mod 1000)
    Case 1000000 To 999999999
        ubah = ubah(Fix(n / 1000000)) + " Juta" + ubah(n Mod 1000000)
    Case Else
        ubah = ubah(Fix(n / 1000000000)) + " Milyar" + ubah(n Mod 1000000000)
  End Select
  End Function

penggunaannya adalah sebagai berikut :



Private Sub Command1_Click()
If Text1 <> "" Then
    Text2.Text = ubah(Text1)
  Else
    Text2.Text = ""
  End If
End Sub

text1 anda isi dengan angka 1000,maka text2 akan menampilkan kata "seribu" dan seterusnya..
text1 anda isi dengan angka 198,maka text2 akan menampilkan kata "seratus sembilan puluh delapan" dan seterusnya..
mudah kan??
^-^

tips tambahan..
anda bisa menambahkan mata uang dengan cara :

Private Sub Command1_Click()
If Text1 <> "" Then
    Text2.Text = ubah(Text1) + "rupiah"
  Else
    Text2.Text = ""
  End If
End Sub

selamat mencoba..

Artikel ini dibuat oleh Yudha Tri Putra,segala macam bentuk pengcopyan atau menyalin sebagian atau seluruh halaman ini,dapat dikenakan sanksi dan melanggar Hak Cipta Yudha Tri Putra sebagai Blogger

0 komentar:

Posting Komentar

(C) 2018. Diberdayakan oleh Blogger.

Categories

Followers