Forum Komunitas Lab BSI Bekasi yang ditujukan untuk sharing ilmu pengetahuan tentang apa saja dan juga sebagai tempat nongkrong kaum intelektual |
| | Angka terbilang vb | |
| | Author | Message |
---|
indrawan21 Administrator
Jumlah posting : 76 Poin : 2147483647 Reputasi : 7 Join date : 2011-05-07 Age : 37 Lokasi : Kelapa Gading Agak kemarian dikit
| Subject: Angka terbilang vb Fri May 13, 2011 10:28 pm | |
| ni karna salah sambung gara2 br tidur 3 jam akhirnya salah masukin reply... hehehe yaudah sekalian ajah neh di share buat trik di vb untuk membuat angka terbilang siapin 2 buah textbox di project trus cioy listing ini semuanya.
Nah abis ntuh tinggal dibikin di text1 change - Code:
-
Private Sub Text_Change() Text2 = TerbilangDesimal(Text) End Sub Copy ajah semua listing di listingan form
Last edited by indrawan21 on Sat May 14, 2011 7:41 am; edited 3 times in total (Reason for editing : LOCKED & Hidden ::: KONTROVERSI :::) | |
| | | zaidkhusain Head Administrator
Jumlah posting : 117 Poin : 2147483647 Reputasi : 1 Join date : 2011-05-07 Age : 34 Lokasi : di Rumah Warning :
| Subject: Re: Angka terbilang vb Fri May 13, 2011 10:45 pm | |
| - indrawan21 wrote:
- ni karna salah sambung gara2 br tidur 3 jam akhirnya salah masukin reply... hehehe
yaudah sekalian ajah neh di share buat trik di vb untuk membuat angka terbilang siapin 2 buah textbox di project trus cioy listing ini semuanya.
Public Function TerbilangDesimal(InputCurrency As String, Optional MataUang As String = "rupiah") As String Dim strInput As String Dim strBilangan As String Dim strPecahan As String On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim i As Integer 'Periksa setiap karakter yg diketikkan ke kotak 'UserID strValid = "1234567890," For i% = 1 To Len(InputCurrency) huruf = Chr(Asc(Mid(InputCurrency, i%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next i% If InputCurrency = "" Then Exit Function If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan strInput = CStr(InputCurrency) 'Konversi ke string 'Periksa apakah ada tanda "," jika ya berarti pecahan If InStr(1, strInput, ",", vbBinaryCompare) Then strBilangan = Left(strInput, InStr(1, strInput, _ ",", vbBinaryCompare) - 1) 'strBilangan = Right(strInput, InStr(1, strInput, _ ' ".", vbBinaryCompare) - 2) strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 1)) If MataUang <> "" Then If CLng(Trim(strPecahan)) > 99 Then strInput = Format(Round(CDbl(strInput), 2), "#0.00") strPecahan = Format((Right(strInput, Len(strInput) - Len(strBilangan) - 1)), "00") End If If Len(Trim(strPecahan)) = 1 Then strInput = Format(Round(CDbl(strInput), 2), _ "#0.00") strPecahan = Format((Right(strInput, _ Len(strInput) - Len(strBilangan) - 1)), "00") End If If CLng(Trim(strPecahan)) = 0 Then TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan)) Else TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan) & "sen") End If Else TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma " & KonversiPecahan(strPecahan)) End If Else TerbilangDesimal = (KonversiBilangan(strInput)) End If Exit Function Pesan: TerbilangDesimal = "(maksimal 15 digit)" End Function
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) Private Function KonversiPecahan(strAngka As String) As String Dim i%, strJmlHuruf$, Urai$, Kar$ If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) Urai = "" Kar = "" For i = 1 To Len(strJmlHuruf) 'Tampung setiap satu karakter ke Kar Kar = Mid(strAngka, i, 1) Urai = Urai & Kata(CInt(Kar)) Next i KonversiPecahan = Urai End Function
'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata Private Function Kata(angka As Byte) As String Select Case angka Case 1: Kata = "satu " Case 2: Kata = "dua " Case 3: Kata = "tiga " Case 4: Kata = "empat " Case 5: Kata = "lima " Case 6: Kata = "enam " Case 7: Kata = "tujuh " Case 8: Kata = "delapan " Case 9: Kata = "sembilan " Case 0: Kata = "nol " End Select End Function
'Ini untuk mengkonversi nilai bilangan sebelum pecahan Private Function KonversiBilangan(strAngka As String) As String Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim X, Y, z As Integer
If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) X = 0 Y = 0 Urai = "" While (X < Len(strJmlHuruf)) X = X 1 strTot = Mid(strJmlHuruf, X, 1) Y = Y Val(strTot) z = Len(strJmlHuruf) - X 1 Select Case Val(strTot) 'Case 0 ' Bil1 = "NOL " Case 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "satu " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "se" Else Bil1 = "satu " End If ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then X = X 1 strTot = Mid(strJmlHuruf, X, 1) z = Len(strJmlHuruf) - X 1 Bil2 = "" Select Case Val(strTot) Case 0 Bil1 = "sepuluh " Case 1 Bil1 = "sebelas " Case 2 Bil1 = "dua belas " Case 3 Bil1 = "tiga belas " Case 4 Bil1 = "empat belas " Case 5 Bil1 = "lima belas " Case 6 Bil1 = "enam belas " Case 7 Bil1 = "tujuh belas " Case 8 Bil1 = "delapan belas " Case 9 Bil1 = "sembilan belas " End Select Else Bil1 = "se" End If Case 2 Bil1 = "dua " Case 3 Bil1 = "tiga " Case 4 Bil1 = "empat " Case 5 Bil1 = "lima " Case 6 Bil1 = "enam " Case 7 Bil1 = "tujuh " Case 8 Bil1 = "delapan " Case 9 Bil1 = "sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then Bil2 = "puluh " ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "ratus " Else Bil2 = "" End If Else Bil2 = "" End If If (Y > 0) Then Select Case z Case 4 Bil2 = Bil2 "ribu " Y = 0 Case 7 Bil2 = Bil2 "juta " Y = 0 Case 10 Bil2 = Bil2 "milyar " Y = 0 Case 13 Bil2 = Bil2 "trilyun " Y = 0 End Select End If Urai = Urai Bil1 Bil2 Wend KonversiBilangan = Urai End Function
Nah abis ntuh tinggal dibikin di text1 change - Code:
-
Private Sub Text_Change() Text2 = TerbilangDesimal(Text) End Sub Copy ajah semua listing di listingan form
terbilang berapa digit nie gan??? | |
| | | indrawan21 Administrator
Jumlah posting : 76 Poin : 2147483647 Reputasi : 7 Join date : 2011-05-07 Age : 37 Lokasi : Kelapa Gading Agak kemarian dikit
| Subject: Re: Angka terbilang vb Fri May 13, 2011 10:56 pm | |
| 100 trilyun | |
| | | zaidkhusain Head Administrator
Jumlah posting : 117 Poin : 2147483647 Reputasi : 1 Join date : 2011-05-07 Age : 34 Lokasi : di Rumah Warning :
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:12 pm | |
| - indrawan21 wrote:
- 100 trilyun
oh rumit jga ye codingna - Code:
-
http://vbthok.blogspot.com/2008/11/membuat-angka-terbilang-dengan-bahasa.html cekibrot coding ente sama m doi??? cantumin sumber gan klo copas nie coding milik vbbego klo ga salah | |
| | | indrawan21 Administrator
Jumlah posting : 76 Poin : 2147483647 Reputasi : 7 Join date : 2011-05-07 Age : 37 Lokasi : Kelapa Gading Agak kemarian dikit
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:15 pm | |
| itu listing dari project tugas lab masbrooo...
untuk listing projek emang ane gentayangan kmana2 | |
| | | zaidkhusain Head Administrator
Jumlah posting : 117 Poin : 2147483647 Reputasi : 1 Join date : 2011-05-07 Age : 34 Lokasi : di Rumah Warning :
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:18 pm | |
| - indrawan21 wrote:
- itu listing dari project tugas lab masbrooo...
untuk listing projek emang ane gentayangan kmana2 oh iy coz setau ane coding terbilang serumit ini kayana dah ane pernah baca artikel di vbbego alna gan oh sipp klo bisa besok dijelasin gan klo ada coding rumit gini biar lwbih gampang dicerna m mahasiswa | |
| | | indrawan21 Administrator
Jumlah posting : 76 Poin : 2147483647 Reputasi : 7 Join date : 2011-05-07 Age : 37 Lokasi : Kelapa Gading Agak kemarian dikit
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:25 pm | |
| coba deh ente baca lagi masbro... hampir tiap listing udah dikasih komentar fungsinya... Contoh : - Code:
-
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) 'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata 'Ini untuk mengkonversi nilai bilangan sebelum pecahan
dan kalo ente lebih jeli,listing yg dari link ente itu beda ama listing ane masbroooo.... ane bikin per function | |
| | | zaidkhusain Head Administrator
Jumlah posting : 117 Poin : 2147483647 Reputasi : 1 Join date : 2011-05-07 Age : 34 Lokasi : di Rumah Warning :
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:38 pm | |
| - indrawan21 wrote:
- coba deh ente baca lagi masbro...
hampir tiap listing udah dikasih komentar fungsinya...
Contoh : - Code:
-
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) 'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata 'Ini untuk mengkonversi nilai bilangan sebelum pecahan
dan kalo ente lebih jeli,listing yg dari link ente itu beda ama listing ane masbroooo.... ane bikin per function oh iy dah | |
| | | indrawan21 Administrator
Jumlah posting : 76 Poin : 2147483647 Reputasi : 7 Join date : 2011-05-07 Age : 37 Lokasi : Kelapa Gading Agak kemarian dikit
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:46 pm | |
| vb thok: - Spoiler:
Public Function TerbilangBulat(strAngka As String, _ Optional MataUang As String = "rupiah") As String Dim strJmlHuruf$, intPecahan As Integer Dim strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim X As Integer, Y As Integer, z As Integer On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim i As Integer 'Periksa setiap karakter yg diketikkan ke kotak
‘UserID strValid = "1234567890" For i% = 1 To Len(strAngka) huruf = Chr(Asc(Mid(strAngka, i%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next i% If strAngka = "" Then Exit Function If Len(Trim(strAngka)) > 15 Then GoTo Pesan strJmlHuruf = LTrim(strAngka) 'intPecahan = Val(Right(Mid(strAngka, 15, 2), 2)) If (intPecahan = 0) Then strPecahan = "" Else 'strPecahan = LTrim(Str(intPecahan)) + "/100 " strPecahan = "" End If X = 0 Y = 0 Urai = "" While (X < Len(strJmlHuruf)) X = X + 1 218 strTot = Mid(strJmlHuruf, X, 1) Y = Y + Val(strTot) z = Len(strJmlHuruf) - X + 1 Select Case Val(strTot) Case 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "satu " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "se" Else Bil1 = "satu " End If ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then X = X + 1 strTot = Mid(strJmlHuruf, X, 1) z = Len(strJmlHuruf) - X + 1 Bil2 = "" Select Case Val(strTot) Case 0: Bil1 = "sepuluh " Case 1: Bil1 = "sebelas " Case 2: Bil1 = "dua belas " Case 3: Bil1 = "tiga belas " Case 4: Bil1 = "empat belas " Case 5: Bil1 = "lima belas " Case 6: Bil1 = "enam belas " Case 7: Bil1 = "tujuh belas " Case 8: Bil1 = "delapan belas " Case 9: Bil1 = "sembilan belas " End Select Else Bil1 = "se" End If Case 2: Bil1 = "dua " Case 3: Bil1 = "tiga " Case 4: Bil1 = "empat " Case 5: Bil1 = "lima " Case 6: Bil1 = "enam " Case 7: Bil1 = "tujuh " Case 8: Bil1 = "delapan " Case 9: Bil1 = "sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then Bil2 = "puluh " ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "ratus " Else Bil2 = "" End If Else Bil2 = "" End If 219 If (Y > 0) Then Select Case z Case 4: Bil2 = Bil2 + "ribu " Y = 0 Case 7: Bil2 = Bil2 + "juta " Y = 0 Case 10: Bil2 = Bil2 + "milyar " Y = 0 Case 13: Bil2 = Bil2 + "trilyun " Y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend Urai = Urai + strPecahan TerbilangBulat = (Urai & MataUang) Exit Function Pesan: TerbilangBulat = "(maksimal 15 digit)" End Function Private Sub Text1_Change() Text2.Text = TerbilangBulat(Text1.Text) End Sub
di mari : - Spoiler:
Public Function TerbilangDesimal(InputCurrency As String, Optional MataUang As String = "rupiah") As String Dim strInput As String Dim strBilangan As String Dim strPecahan As String On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim i As Integer 'Periksa setiap karakter yg diketikkan ke kotak 'UserID strValid = "1234567890," For i% = 1 To Len(InputCurrency) huruf = Chr(Asc(Mid(InputCurrency, i%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next i% If InputCurrency = "" Then Exit Function If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan strInput = CStr(InputCurrency) 'Konversi ke string 'Periksa apakah ada tanda "," jika ya berarti pecahan If InStr(1, strInput, ",", vbBinaryCompare) Then strBilangan = Left(strInput, InStr(1, strInput, _ ",", vbBinaryCompare) - 1) 'strBilangan = Right(strInput, InStr(1, strInput, _ ' ".", vbBinaryCompare) - 2) strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 1)) If MataUang <> "" Then If CLng(Trim(strPecahan)) > 99 Then strInput = Format(Round(CDbl(strInput), 2), "#0.00") strPecahan = Format((Right(strInput, Len(strInput) - Len(strBilangan) - 1)), "00") End If If Len(Trim(strPecahan)) = 1 Then strInput = Format(Round(CDbl(strInput), 2), _ "#0.00") strPecahan = Format((Right(strInput, _ Len(strInput) - Len(strBilangan) - 1)), "00") End If If CLng(Trim(strPecahan)) = 0 Then TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan)) Else TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan) & "sen") End If Else TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma " & KonversiPecahan(strPecahan)) End If Else TerbilangDesimal = (KonversiBilangan(strInput)) End If Exit Function Pesan: TerbilangDesimal = "(maksimal 15 digit)" End Function
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) Private Function KonversiPecahan(strAngka As String) As String Dim i%, strJmlHuruf$, Urai$, Kar$ If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) Urai = "" Kar = "" For i = 1 To Len(strJmlHuruf) 'Tampung setiap satu karakter ke Kar Kar = Mid(strAngka, i, 1) Urai = Urai & Kata(CInt(Kar)) Next i KonversiPecahan = Urai End Function
'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata Private Function Kata(angka As Byte) As String Select Case angka Case 1: Kata = "satu " Case 2: Kata = "dua " Case 3: Kata = "tiga " Case 4: Kata = "empat " Case 5: Kata = "lima " Case 6: Kata = "enam " Case 7: Kata = "tujuh " Case 8: Kata = "delapan " Case 9: Kata = "sembilan " Case 0: Kata = "nol " End Select End Function
'Ini untuk mengkonversi nilai bilangan sebelum pecahan Private Function KonversiBilangan(strAngka As String) As String Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim X, Y, z As Integer
If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) X = 0 Y = 0 Urai = "" While (X < Len(strJmlHuruf)) X = X + 1 strTot = Mid(strJmlHuruf, X, 1) Y = Y + Val(strTot) z = Len(strJmlHuruf) - X + 1 Select Case Val(strTot) 'Case 0 ' Bil1 = "NOL " Case 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "satu " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "se" Else Bil1 = "satu " End If ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then X = X + 1 strTot = Mid(strJmlHuruf, X, 1) z = Len(strJmlHuruf) - X + 1 Bil2 = "" Select Case Val(strTot) Case 0 Bil1 = "sepuluh " Case 1 Bil1 = "sebelas " Case 2 Bil1 = "dua belas " Case 3 Bil1 = "tiga belas " Case 4 Bil1 = "empat belas " Case 5 Bil1 = "lima belas " Case 6 Bil1 = "enam belas " Case 7 Bil1 = "tujuh belas " Case 8 Bil1 = "delapan belas " Case 9 Bil1 = "sembilan belas " End Select Else Bil1 = "se" End If Case 2 Bil1 = "dua " Case 3 Bil1 = "tiga " Case 4 Bil1 = "empat " Case 5 Bil1 = "lima " Case 6 Bil1 = "enam " Case 7 Bil1 = "tujuh " Case 8 Bil1 = "delapan " Case 9 Bil1 = "sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then Bil2 = "puluh " ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "ratus " Else Bil2 = "" End If Else Bil2 = "" End If If (Y > 0) Then Select Case z Case 4 Bil2 = Bil2 + "ribu " Y = 0 Case 7 Bil2 = Bil2 + "juta " Y = 0 Case 10 Bil2 = Bil2 + "milyar " Y = 0 Case 13 Bil2 = Bil2 + "trilyun " Y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend KonversiBilangan = Urai End Function
1 function ama 4 function sama ??? ATM (Analisa Teliti Modifikasi) legal kata dosen 2 yg ngajar ane masbro | |
| | | zaidkhusain Head Administrator
Jumlah posting : 117 Poin : 2147483647 Reputasi : 1 Join date : 2011-05-07 Age : 34 Lokasi : di Rumah Warning :
| Subject: Re: Angka terbilang vb Fri May 13, 2011 11:50 pm | |
| - indrawan21 wrote:
- vb thok:
- Spoiler:
Public Function TerbilangBulat(strAngka As String, _ Optional MataUang As String = "rupiah") As String Dim strJmlHuruf$, intPecahan As Integer Dim strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim X As Integer, Y As Integer, z As Integer On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim i As Integer 'Periksa setiap karakter yg diketikkan ke kotak
‘UserID strValid = "1234567890" For i% = 1 To Len(strAngka) huruf = Chr(Asc(Mid(strAngka, i%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next i% If strAngka = "" Then Exit Function If Len(Trim(strAngka)) > 15 Then GoTo Pesan strJmlHuruf = LTrim(strAngka) 'intPecahan = Val(Right(Mid(strAngka, 15, 2), 2)) If (intPecahan = 0) Then strPecahan = "" Else 'strPecahan = LTrim(Str(intPecahan)) + "/100 " strPecahan = "" End If X = 0 Y = 0 Urai = "" While (X < Len(strJmlHuruf)) X = X + 1 218 strTot = Mid(strJmlHuruf, X, 1) Y = Y + Val(strTot) z = Len(strJmlHuruf) - X + 1 Select Case Val(strTot) Case 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "satu " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "se" Else Bil1 = "satu " End If ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then X = X + 1 strTot = Mid(strJmlHuruf, X, 1) z = Len(strJmlHuruf) - X + 1 Bil2 = "" Select Case Val(strTot) Case 0: Bil1 = "sepuluh " Case 1: Bil1 = "sebelas " Case 2: Bil1 = "dua belas " Case 3: Bil1 = "tiga belas " Case 4: Bil1 = "empat belas " Case 5: Bil1 = "lima belas " Case 6: Bil1 = "enam belas " Case 7: Bil1 = "tujuh belas " Case 8: Bil1 = "delapan belas " Case 9: Bil1 = "sembilan belas " End Select Else Bil1 = "se" End If Case 2: Bil1 = "dua " Case 3: Bil1 = "tiga " Case 4: Bil1 = "empat " Case 5: Bil1 = "lima " Case 6: Bil1 = "enam " Case 7: Bil1 = "tujuh " Case 8: Bil1 = "delapan " Case 9: Bil1 = "sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then Bil2 = "puluh " ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "ratus " Else Bil2 = "" End If Else Bil2 = "" End If 219 If (Y > 0) Then Select Case z Case 4: Bil2 = Bil2 + "ribu " Y = 0 Case 7: Bil2 = Bil2 + "juta " Y = 0 Case 10: Bil2 = Bil2 + "milyar " Y = 0 Case 13: Bil2 = Bil2 + "trilyun " Y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend Urai = Urai + strPecahan TerbilangBulat = (Urai & MataUang) Exit Function Pesan: TerbilangBulat = "(maksimal 15 digit)" End Function Private Sub Text1_Change() Text2.Text = TerbilangBulat(Text1.Text) End Sub
di mari :
- Spoiler:
Public Function TerbilangDesimal(InputCurrency As String, Optional MataUang As String = "rupiah") As String Dim strInput As String Dim strBilangan As String Dim strPecahan As String On Error GoTo Pesan Dim strValid As String, huruf As String * 1 Dim i As Integer 'Periksa setiap karakter yg diketikkan ke kotak 'UserID strValid = "1234567890," For i% = 1 To Len(InputCurrency) huruf = Chr(Asc(Mid(InputCurrency, i%, 1))) If InStr(strValid, huruf) = 0 Then Set AngkaTerbilang = Nothing MsgBox "Harus karakter angka!", _ vbCritical, "Karakter Tidak Valid" Exit Function End If Next i% If InputCurrency = "" Then Exit Function If Len(Trim(InputCurrency)) > 15 Then GoTo Pesan strInput = CStr(InputCurrency) 'Konversi ke string 'Periksa apakah ada tanda "," jika ya berarti pecahan If InStr(1, strInput, ",", vbBinaryCompare) Then strBilangan = Left(strInput, InStr(1, strInput, _ ",", vbBinaryCompare) - 1) 'strBilangan = Right(strInput, InStr(1, strInput, _ ' ".", vbBinaryCompare) - 2) strPecahan = Trim(Right(strInput, Len(strInput) - Len(strBilangan) - 1)) If MataUang <> "" Then If CLng(Trim(strPecahan)) > 99 Then strInput = Format(Round(CDbl(strInput), 2), "#0.00") strPecahan = Format((Right(strInput, Len(strInput) - Len(strBilangan) - 1)), "00") End If If Len(Trim(strPecahan)) = 1 Then strInput = Format(Round(CDbl(strInput), 2), _ "#0.00") strPecahan = Format((Right(strInput, _ Len(strInput) - Len(strBilangan) - 1)), "00") End If If CLng(Trim(strPecahan)) = 0 Then TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan)) Else TerbilangDesimal = (KonversiBilangan(strBilangan) & MataUang & " " & KonversiBilangan(strPecahan) & "sen") End If Else TerbilangDesimal = (KonversiBilangan(strBilangan) & "koma " & KonversiPecahan(strPecahan)) End If Else TerbilangDesimal = (KonversiBilangan(strInput)) End If Exit Function Pesan: TerbilangDesimal = "(maksimal 15 digit)" End Function
'Fungsi ini untuk mengkonversi nilai pecahan (setelah 'angka 0) Private Function KonversiPecahan(strAngka As String) As String Dim i%, strJmlHuruf$, Urai$, Kar$ If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) Urai = "" Kar = "" For i = 1 To Len(strJmlHuruf) 'Tampung setiap satu karakter ke Kar Kar = Mid(strAngka, i, 1) Urai = Urai & Kata(CInt(Kar)) Next i KonversiPecahan = Urai End Function
'Fungsi ini untuk menterjemahkan setiap satu angka ke 'kata Private Function Kata(angka As Byte) As String Select Case angka Case 1: Kata = "satu " Case 2: Kata = "dua " Case 3: Kata = "tiga " Case 4: Kata = "empat " Case 5: Kata = "lima " Case 6: Kata = "enam " Case 7: Kata = "tujuh " Case 8: Kata = "delapan " Case 9: Kata = "sembilan " Case 0: Kata = "nol " End Select End Function
'Ini untuk mengkonversi nilai bilangan sebelum pecahan Private Function KonversiBilangan(strAngka As String) As String Dim strJmlHuruf$, intPecahan As Integer, strPecahan$, Urai$, Bil1$, strTot$, Bil2$ Dim X, Y, z As Integer
If strAngka = "" Then Exit Function strJmlHuruf = Trim(strAngka) X = 0 Y = 0 Urai = "" While (X < Len(strJmlHuruf)) X = X + 1 strTot = Mid(strJmlHuruf, X, 1) Y = Y + Val(strTot) z = Len(strJmlHuruf) - X + 1 Select Case Val(strTot) 'Case 0 ' Bil1 = "NOL " Case 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "satu " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "se" Else Bil1 = "satu " End If ElseIf (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then X = X + 1 strTot = Mid(strJmlHuruf, X, 1) z = Len(strJmlHuruf) - X + 1 Bil2 = "" Select Case Val(strTot) Case 0 Bil1 = "sepuluh " Case 1 Bil1 = "sebelas " Case 2 Bil1 = "dua belas " Case 3 Bil1 = "tiga belas " Case 4 Bil1 = "empat belas " Case 5 Bil1 = "lima belas " Case 6 Bil1 = "enam belas " Case 7 Bil1 = "tujuh belas " Case 8 Bil1 = "delapan belas " Case 9 Bil1 = "sembilan belas " End Select Else Bil1 = "se" End If Case 2 Bil1 = "dua " Case 3 Bil1 = "tiga " Case 4 Bil1 = "empat " Case 5 Bil1 = "lima " Case 6 Bil1 = "enam " Case 7 Bil1 = "tujuh " Case 8 Bil1 = "delapan " Case 9 Bil1 = "sembilan " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2 Or z = 5 Or z = 8 Or z = 11 Or z = 14) Then Bil2 = "puluh " ElseIf (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "ratus " Else Bil2 = "" End If Else Bil2 = "" End If If (Y > 0) Then Select Case z Case 4 Bil2 = Bil2 + "ribu " Y = 0 Case 7 Bil2 = Bil2 + "juta " Y = 0 Case 10 Bil2 = Bil2 + "milyar " Y = 0 Case 13 Bil2 = Bil2 + "trilyun " Y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend KonversiBilangan = Urai End Function
1 function ama 4 function sama ??? ATM (Analisa Teliti Modifikasi) legal kata dosen 2 yg ngajar ane masbro oh iy dah | |
| | | Sponsored content
| Subject: Re: Angka terbilang vb | |
| |
| | | | Angka terbilang vb | |
|
Similar topics | |
|
| Permissions in this forum: | You cannot reply to topics in this forum
| |
| |
| |
|