Klo mau jelas Download aja di Indoprog, Or
www.homepageku.cjb.net
www.immawanbuchori.cjb.net
Semoga Membantu..!!!
Option Explicit
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
__________________________________________________
Do You Yahoo!?
Tired of spam? Yahoo! Mail has the best spam protection around
http://mail.yahoo.com
Untuk berhenti berlangganan kirim email kosong ke : [EMAIL PROTECTED]
Ikuti juga forum diskusi VB.net dengan
mengirim email kosong ke [EMAIL PROTECTED]
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/indoprog-vb/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
