Kepada Yth.
Narasumber
saya menggunakan source ANGKA TO TEKS dari Wahana Progremer Indonesia
tetapi adamasalah yaitu apabila dimasukan angka 1000000 (1Jt)
maka hasilnya SATU JUTA RIBU RUPIAH,kalo 1000000000 (1M)
hasilnya SATU MILYAR JUTA RIBU RUPIAH
saya dah coba utak atik tapi belum berhasil.
saya mohon pada narasumber untuk memberikan solusinya
Bersama ini saya lampirkan Source code-nya
Terima kasih
________________________________________________________
Bergabunglah dengan orang-orang yang berwawasan, di di bidang Anda! Kunjungi
Yahoo! Answers saat ini juga di http://id.answers.yahoo.com/Option Explicit
'---------------------------------------------------
'
' (c) Copyright January 2003, Immawan Buchori, S.Pd
' WahanaProgrammer.net
' blogs.WahanaProgrammer.net
'
'---------------------------------------------------
'
' Jika ada kekeliruan atau ketidaktepatan hasil konversi
' kami berharap anda sudi memberitahukan kami.
'
' Andapun bisa melakukan modifikasi sesuai selera anda,
' tetapi jika mempublikasikannya jangan hapus Copyright-nya.
'
' Semoga anda menjadi Programmer Profesional. Amien.
'
'
' Sebelumnya anda persiapkan satu CommandButton dan
' TextBox pada Form Standart, lalu copy kode dibawah ini
' ke dalam form tersebut.
'
'---------------------------------------------------
Dim llKoma As Boolean
Dim lsTeks1 As String
Dim lsTeks2 As String
Private Sub cmdShowTerbilang_Click()
MsgBox Trim(AngkaToTeks(Trim(txtAngka))), , "Angka Terbilang"
End Sub
Private Function AngkaToTeks(txtAngka) As String
Dim lsAngka As String
Dim lsKomaAngka As String
Dim lsTmpAngkaToTeks As String
Dim i As Integer
Dim lnToLoop As Integer
i = 0
lsAngka = ""
lsKomaAngka = ""
lnToLoop = 0
lsTmpAngkaToTeks = ""
' Jika ada koma, tangkap angka dibelakang koma dengan var lsKomaAngka
If llKoma Then
lsAngka = Trim(Str(Val(Left(txtAngka, InStr(txtAngka, ",") - 1))))
lsKomaAngka = Mid(txtAngka, InStr(txtAngka, ",") + 1)
Else
lsAngka = Trim(Str(Val(txtAngka)))
lsKomaAngka = ""
End If
If Val(lsAngka) = 0 Then
AngkaToTeks = "Nol" & IIf(Val(lsKomaAngka) = 0, " Rupiah", _
KomaAngka(lsKomaAngka))
Exit Function
End If
' Angka Maks. dalam Triliun, mis. 550.750.925.623.450,5284
If Len(lsAngka) > 18 Then
AngkaToTeks = "Jumlah digit Angka maks. 18." & Chr(13) & _
"Jumlah digit dibelakang koma terserah anda."
Exit Function
End If
If ((Len(lsAngka) / 3) - Int(Len(lsAngka) / 3)) > 0 Then
lnToLoop = (Int(Len(lsAngka) / 3) * 3 + 3) / 3
lsAngka = Space(Int(Len(lsAngka) / 3) * 3 + 3 - Len(lsAngka)) & lsAngka
Else
lnToLoop = Len(lsAngka) / 3
End If
' Looping (lnToLoop) disini dihitung berdasarkan kelipatan 3 dari
' panjang lsAngka.
For i = 1 To lnToLoop
' Logika ini berfungsi mencegah angka seribu 1234, jika tidak
' dicegah akan muncul SATU RIBU bukanya SERIBU.
' dan Loopingnya dinaikkan satu, karena variable lsAngka telah
' dikurangi satu karakter, tadinya 1234 menjadi 234.
If Len(Trim(lsAngka)) = 4 And Left(Trim(lsAngka), 1) = 1 Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + " Seribu "
lsAngka = Right(lsAngka, 3)
i = 2
End If
If Mid(lsAngka, 1, 1) = "1" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + " Seratus "
End If
If Mid(lsAngka, 1, 1) > "1" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 1, 1)) * 8 - 7, 8)) + _
" Ratus "
End If
If Mid(lsAngka, 2, 1) = "1" Then
Select Case Mid(lsAngka, 3, 1)
Case Is = "0"
lsTmpAngkaToTeks = lsTmpAngkaToTeks + " Sepuluh "
Case Is = "1"
lsTmpAngkaToTeks = lsTmpAngkaToTeks + " Sebelas "
Case Is > "1"
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 3, 1)) * 8 - 7, 8)) + _
" Belas "
End Select
End If
If Mid(lsAngka, 2, 1) > "1" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 2, 1)) * 8 - 7, 8)) + _
" Puluh "
If Mid(lsAngka, 3, 1) > "0" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 3, 1)) * 8 - 7, 8))
End If
End If
If Mid(lsAngka, 2, 1) = "0" And Mid(lsAngka, 3, 1) > "0" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 3, 1)) * 8 - 7, 8))
End If
If Mid(lsAngka, 1, 2) = " " And Mid(lsAngka, 3, 1) > "0" Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks + _
RTrim(Mid(lsTeks1, Val(Mid(lsAngka, 3, 1)) * 8 - 7, 8))
End If
' Mengambil lsTeks2
If Not IsEmpty(lsTmpAngkaToTeks) Then
lsTmpAngkaToTeks = lsTmpAngkaToTeks & " " & _
RTrim(Mid(lsTeks2, Len(lsAngka) / 3 * 7 - 6, 7)) & " "
End If
lsAngka = Mid(lsAngka, 4)
Next i
If Not llKoma Then
AngkaToTeks = lsTmpAngkaToTeks
Else
AngkaToTeks = lsTmpAngkaToTeks & KomaAngka(lsKomaAngka)
End If
End Function
Private Function KomaAngka(sKomaAngka As String) As String
Dim i As Integer
Dim lsTmpKomaAngka As String
i = 0
lsTmpKomaAngka = ""
For i = 1 To Len(sKomaAngka)
If Val(Mid(sKomaAngka, i, 1)) = 0 Then
lsTmpKomaAngka = lsTmpKomaAngka & "Nol "
Else
lsTmpKomaAngka = lsTmpKomaAngka & RTrim(Mid(lsTeks1, _
Val(Mid(sKomaAngka, i, 1)) * 8 - 7, 8)) & " "
End If
Next i
KomaAngka = " Koma " & lsTmpKomaAngka
End Function
Private Sub Form_Initialize()
lsTeks1 = "Satu Dua Tiga Empat Lima Enam " & _
"Tujuh Delapan Sembilan"
lsTeks2 = "Rupiah Ribu Juta Milyar Triliun"
llKoma = False
End Sub
Private Sub txtAngka_KeyPress(KeyAscii As Integer)
If Not ((KeyAscii >= 48 And KeyAscii <= 57) Or _
KeyAscii = 8 Or _
KeyAscii = 44) Then KeyAscii = 0
If KeyAscii = 44 And llKoma Then KeyAscii = 0
End Sub
Private Sub txtAngka_KeyUp(KeyCode As Integer, Shift As Integer)
llKoma = IIf(InStr(txtAngka.Text, ",") > 0, True, False)
End Sub
