Coba pake fungsi ini:
Function NumToText(dblValue As Double) As String
Static satuan(0 To 9) As String
Static belasan(0 To 9) As String
Static puluhan(0 To 9) As String
Static ribuan(0 To 4) As String
Dim i As Integer, nPosition As Integer
Dim nDigit As Integer, bAllZeros As Integer
Dim strResult As String, strTemp As String
Dim tmpBuff As String
satuan(0) = "nol"
satuan(1) = "satu"
satuan(2) = "dua"
satuan(3) = "tiga"
satuan(4) = "empat"
satuan(5) = "lima"
satuan(6) = "enam"
satuan(7) = "tujuh"
satuan(8) = "delapan"
satuan(9) = "sembilan"
belasan(0) = "sepuluh"
belasan(1) = "sebelas"
belasan(2) = "duabelas"
belasan(3) = "tigabelas"
belasan(4) = "empatbelas"
belasan(5) = "limabelas"
belasan(6) = "enambelas"
belasan(7) = "tujuhbelas"
belasan(8) = "delapanbelas"
belasan(9) = "sembilanbelas"
puluhan(0) = ""
puluhan(1) = "sepuluh"
puluhan(2) = "duapuluh"
puluhan(3) = "tigapuluh"
puluhan(4) = "empatpuluh"
puluhan(5) = "limapuluh"
puluhan(6) = "enampuluh"
puluhan(7) = "tujuhpuluh"
puluhan(8) = "delapanpuluh"
puluhan(9) = "sembilanpuluh"
ribuan(0) = ""
ribuan(1) = "ribu"
ribuan(2) = "juta"
ribuan(3) = "miliar"
ribuan(4) = "triliun"
'Errors Handler
On Error GoTo NumToTextError
' Tulisan Rupiah
strResult = "rupiah "
' Konversi ke Text
strTemp = CStr(Int(dblValue))
' Diulang sebanyak panjang teks
For i = Len(strTemp) To 1 Step -1
'Ambil nilai angka posisi ke-i
nDigit = Val(Mid(strTemp, i, 1))
'Ambil posisi angka
nPosition = (Len(strTemp) - i) + 1
'Pilihan proses tergantung posisi satuan, puluhan, atau ratusan
Select Case (nPosition Mod 3)
Case 1 'Posisi satuan
bAllZeros = False
If i = 1 Then
tmpBuff = satuan(nDigit) & " "
ElseIf Mid$(strTemp, i - 1, 1) = "1" Then
tmpBuff = belasan(nDigit) & " "
i = i - 1 'Skip posisi puluhan
ElseIf nDigit > 0 Then
tmpBuff = satuan(nDigit) & " "
Else
'Jika angka Puluhan dan Ratusan juga
'angka nol, maka Jangan tampilkan ribuan
bAllZeros = True
If i > 1 Then
If Mid$(strTemp, i - 1, 1) <> "0" Then
bAllZeros = False
End If
End If
If i > 2 Then
If Mid$(strTemp, i - 2, 1) <> "0" Then
bAllZeros = False
End If
End If
tmpBuff = ""
End If
If bAllZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & ribuan(nPosition / 3) & " "
End If
strResult = tmpBuff & strResult
Case 2 'Posisi Puluhan
If nDigit > 0 Then
strResult = puluhan(nDigit) & " " & strResult
End If
Case 0 'Posisi Ratusan
If nDigit > 0 Then
If nDigit = 1 Then
strResult = "seratus " & strResult
Else
strResult = ratusan(nDigit) & " ratus " & strResult
End If
End If
End Select
Next i
'Konversi huruf pertama ke upper case
If Len(strResult) > 0 Then
strResult = UCase$(left$(strResult, 1)) & Mid$(strResult, 2)
End If
EndNumToText:
'Mengembalikan Teks hasil
NumToText = strResult
Exit Function
NumToTextError:
strResult = "#Error#"
Resume EndNumToText
End Function
hendray_x <[EMAIL PROTECTED]> wrote:
saya belum tahu bgmn caranya agar nilai Rp. 100 menjadi tulisan
seratus rupiah!!, saya lagi belajar utk buat kwitansi nih tolong dong?
please.............
Untuk berhenti berlangganan kirim email kosong ke : [EMAIL PROTECTED]
Ikuti juga forum diskusi VB.net dengan
mengirim email kosong ke [EMAIL PROTECTED]
SPONSORED LINKS
Computer internet security Computer internet business Computer
internet access Computer internet privacy securities Computer internet
help Computer internet connection
---------------------------------
YAHOO! GROUPS LINKS
Visit your group "indoprog-vb" on the web.
To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
Your use of Yahoo! Groups is subject to the Yahoo! Terms of Service.
---------------------------------
---------------------------------
How low will we go? Check out Yahoo! Messengers low PC-to-Phone call rates.
[Non-text portions of this message have been removed]
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/
