Coba juga yang ini untuk versi Dollar. Semoga Bermanfaat,
GBU, Alex Reinhard S ---------------------------- 'English ----------------------------- Public Function TbilDollar(strAngka As String) As String Dim strJmlHuruf As String Dim strPecahan As String Dim Urai As String Dim Bil1 As String Dim strTot As String Dim Bil2, UraiDesimal As String Dim intPecahan, i, digitke As Integer Dim adaDesimal As Boolean Dim BacaAngka As String Dim Desimalnya As String Dim X, Y, z As Integer '--Cek Desimal bo....... adaDesimal = False 'adaDesimal = (Val(strAngka) = Int(Val(strAngka))) 'digitke = Len(Str(Int(strAngka))) + 1 For i = 1 To 16 If Mid(strAngka, i, 1) = "," Or Mid(strAngka, i, 1) = "." Then adaDesimal = True digitke = Len(strAngka) - i End If Next '--end of Cek Desimal If strAngka = "" Or Len(strAngka) > 16 Then Exit Function '---Starting to separate desimal If adaDesimal Then Desimalnya = Right(strAngka, digitke) BacaAngka = Mid(strAngka, 1, Len(strAngka) - (digitke + 1)) strAngka = BacaAngka End If '---end of Starting to separate desimal strJmlHuruf = LTrim(strAngka) intPecahan = Val(Right(Mid(strAngka, 16, 2), 2)) If (intPecahan = 0) Then strPecahan = "" Else strPecahan = LTrim(Str(intPecahan)) + "/100 " End If 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 1 If (z = 1 Or z = 7 Or z = 10 Or z = 13) Then Bil1 = "One " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "One " Else Bil1 = "One " 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 = "Ten " Case 1 Bil1 = "Eleven " Case 2 Bil1 = "Twelve " Case 3 Bil1 = "Thirteen " Case 4 Bil1 = "Fourteen " Case 5 Bil1 = "Fifteen " Case 6 Bil1 = "Sixteen " Case 7 Bil1 = "Seventeen " Case 8 Bil1 = "Eighteen " Case 9 Bil1 = "Nineteen " End Select Else Bil1 = "One " End If Case 2 Bil1 = "Two " Case 3 Bil1 = "Three " Case 4 Bil1 = "Four " Case 5 Bil1 = "Five " Case 6 Bil1 = "Six " Case 7 Bil1 = "Seven " Case 8 Bil1 = "Eight " Case 9 Bil1 = "Nine " 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 Select Case Val(strTot) Case 2 Bil1 = "Twenty " Case 3 Bil1 = "Thirty " Case 4 Bil1 = "Fourty " Case 5 Bil1 = "Fifty " Case 6 Bil1 = "Sixty " Case 7 Bil1 = "Seventy " Case 8 Bil1 = "Eighty " Case 9 Bil1 = "Ninety " End Select End If If (z = 3 Or z = 6 Or z = 9 Or z = 12 Or z = 15) Then Bil2 = "Hundred " Else Bil2 = "" End If Else Bil2 = "" End If If (Y > 0) Then Select Case z Case 4 Bil2 = Bil2 + "Thousand " Y = 0 Case 7 Bil2 = Bil2 + "Million " Y = 0 Case 10 Bil2 = Bil2 + "Billion " Y = 0 Case 13 Bil2 = Bil2 + "Trillion " Y = 0 End Select End If Urai = Urai + Bil1 + Bil2 Wend Urai = Urai + strPecahan '---ucap desimal X = 0 Y = 0 UraiDesimal = "" If Len(Desimalnya) = 1 Then Desimalnya = Desimalnya + "0" While (X < Len(Desimalnya)) X = X + 1 strTot = Mid(Desimalnya, X, 1) Y = Y + Val(strTot) z = Len(Desimalnya) - X + 1 Select Case Val(strTot) Case 1 If (z = 1) Then Bil1 = "One " ElseIf (z = 4) Then If (X = 1) Then Bil1 = "One " End If ElseIf (z = 2) Then X = X + 1 strTot = Mid(Desimalnya, X, 1) z = Len(Desimalnya) - X + 1 Bil2 = "" Select Case Val(strTot) Case 0 Bil1 = "Ten " Case 1 Bil1 = "Eleven " Case 2 Bil1 = "Twelve " Case 3 Bil1 = "Thirteen " Case 4 Bil1 = "Fourteen " Case 5 Bil1 = "Fifteen " Case 6 Bil1 = "Sixteen " Case 7 Bil1 = "Seventeen " Case 8 Bil1 = "Eighteen " Case 9 Bil1 = "Nineteen " End Select End If Case 2 Bil1 = "Two " Case 3 Bil1 = "Three " Case 4 Bil1 = "Four " Case 5 Bil1 = "Five " Case 6 Bil1 = "Six " Case 7 Bil1 = "Seven " Case 8 Bil1 = "Eight " Case 9 Bil1 = "Nine " Case Else Bil1 = "" End Select If (Val(strTot) > 0) Then If (z = 2) Then Select Case Val(strTot) Case 2 Bil1 = "Twenty " Case 3 Bil1 = "Thirty " Case 4 Bil1 = "Fourty " Case 5 Bil1 = "Fifty " Case 6 Bil1 = "Sixty " Case 7 Bil1 = "Seventy " Case 8 Bil1 = "Eighty " Case 9 Bil1 = "Ninety " Case Else Bil1 = "" End Select Else Bil2 = "" End If Else Bil2 = "" End If UraiDesimal = UraiDesimal + Bil1 + Bil2 Wend 'end of ucap desimal If adaDesimal Then TbilDollar = "# " & Urai & "US Dollar " + UraiDesimal + "Cent #" Else TbilDollar = "# " & Urai & "US Dollar #" End If End Function --- In [email protected], Amir <[EMAIL PROTECTED]> wrote: > > Dear Herawandono, > Cobain yang ini mungkin bisa bantu: > > Function Terbilang(Nilai) > Snil = Format(Str(Nilai), "000000000") > JUTA = Mid(Snil, 1, 3) > RIBU = Mid(Snil, 4, 3) > SATU = Mid(Snil, 7, 3) > > If JUTA = "000" Then > JUT = "" > Else > UCAP = Ucapan(JUTA) > JUT = UCAP + "Juta" > End If > > If RIBU = "000" Then > RIB = "" > Else > UCAP = Ucapan(RIBU) > RIB = UCAP + "Ribu" > End If > > If SATU = "000" Then > SAT = "" > Else > UCAP = Ucapan(SATU) > SAT = UCAP > End If > Terbilang = "# " + JUT + RIB + SAT + " Rupiah# " > End Function > > Function Ucapan(bilang) > RATUSAN = Left(bilang, 1) > PULUHAN = Mid(bilang, 2, 1) > SATUAN = Right(bilang, 1) > > Select Case RATUSAN > Case "0" > SRATUS = "" > Case " " > SRATUS = "" > Case "1" > SRATUS = "seratus " > Case "2" > SRATUS = "Dua Ratus " > Case "3" > SRATUS = "Tiga Ratus " > Case "4" > SRATUS = "Empat Ratus " > Case "5" > SRATUS = "Lima Ratus " > Case "6" > SRATUS = "Enam Ratus " > Case "7" > SRATUS = "Tujuh Ratus " > Case "8" > SRATUS = "Delapan Ratus " > Case "9" > SRATUS = "Sembilan Ratus " > End Select > > Select Case PULUHAN > Case "0" > SPULUH = "" > Case "" > SPULUH = "" > Case "2" > SPULUH = "Dua Puluh " > Case "3" > SPULUH = "Tiga Puluh " > Case "4" > SPULUH = "Empat Puluh " > Case "5" > SPULUH = "Lima Puluh " > Case "6" > SPULUH = "Enam Puluh " > Case "7" > SPULUH = "Tujuh Puluh " > Case "8" > SPULUH = "Delapan Puluh " > Case "9" > SPULUH = "Sembilan Puluh " > End Select > > If PULUHAN = "1" Then > Select Case SATUAN > Case "0" > SSATU = "Sepuluh " > Case "1" > SSATU = "Sebelas " > Case "2" > SSATU = "Dua Belas " > Case "3" > SSATU = "Tiga Belas " > Case "4" > SSATU = "empat belas " > Case "5" > SSATU = "Lima Belas " > Case "6" > SSATU = "Enam Belas " > Case "7" > SSATU = "Tujuh Belas " > Case "8" > SSATU = "Delapan Belas " > Case "9" > SSATU = "Sembilan Belas " > End Select > Else > Select Case SATUAN > Case "0" > SSATU = "" > Case "" > SSATU = "" > Case "1" > SSATU = "Satu " > Case "2" > SSATU = "Dua " > Case "3" > SSATU = "Tiga " > Case "4" > SSATU = "Empat " > Case "5" > SSATU = "Lima " > Case "6" > SSATU = "Enam " > Case "7" > SSATU = "Tujuh " > Case "8" > SSATU = "Delapan " > Case "9" > SSATU = "Sembilan " > End Select > End If > > Ucapan = SRATUS + SPULUH + SSATU > End Function > > > Rgd, > Amir > > --- Herawandono Anantija <[EMAIL PROTECTED]> > wrote: > > > Kepada reken2x > > Kami mohon bantuannya bagiamana penulisan module > > untuk > > angka rupiah menjadi dalam huruf pada Microsoft > > access.Adapun saya telah mempeolehnya dg sedikit > > modifikasi dari saya (sbg.mana dibawah), namun untuk > > Rp.100,-(tertulis satu ratus rupiah);dan > > Rp.1.000,-(tertulis Satu Ribu Rupiah) > > > > Terima kasih, bantuannnya > > > > Function ConvertCurrencyToIndonesia(ByVal MyNumber) > > Dim Temp > > Dim rupiah, sen > > Dim DecimalPlace, Count > > > > ReDim Place(9) As String > > Place(2) = " ribu " > > Place(3) = " juta " > > Place(4) = " milyar " > > Place(5) = " trilyun " > > > > ' Convert MyNumber to a string, trimming > > extra spaces. > > MyNumber = Trim(Str(MyNumber)) > > > > ' Find decimal place. > > DecimalPlace = InStr(MyNumber, ".") > > > > ' If we find decimal place... > > If DecimalPlace > 0 Then > > ' Convert sen > > Temp = left(Mid(MyNumber, DecimalPlace + > > 1) & "00", 2) > > sen = ConvertPuluh(Temp) > > > > ' Strip off sen from remainder to > > convert. > > MyNumber = Trim(left(MyNumber, > > DecimalPlace - 1)) > > End If > > > > Count = 1 > > Do While MyNumber <> "" > > ' Convert last 3 digits of MyNumber to > > Indonesia rupiah. > > Temp = ConvertRatus(Right(MyNumber, 3)) > > If Temp <> "" Then rupiah = Temp & > > Place(Count) & rupiah > > If Len(MyNumber) > 3 Then > > ' Remove last 3 converted digits from > > MyNumber. > > MyNumber = left(MyNumber, > > Len(MyNumber) > > - 3) > > Else > > MyNumber = "" > > End If > > Count = Count + 1 > > Loop > > > > ' Clean up rupiah. > > Select Case rupiah > > Case "" > > rupiah = " " > > Case "satu" > > rupiah = "satu rupiah" > > Case Else > > rupiah = rupiah & " rupiah" > > End Select > > > > ' Clean up sen. > > Select Case sen > > Case "" > > sen = " " > > Case "satu" > > sen = " , satu sen" > > Case Else > > sen = " , " & sen & " sen" > > End Select > > > > ConvertCurrencyToIndonesia = rupiah & sen > > End Function > > > > > > Private Function ConvertDigit(ByVal MyDigit) > > Select Case Val(MyDigit) > > Case 1: ConvertDigit = "satu" > > Case 2: ConvertDigit = "dua" > > Case 3: ConvertDigit = "tiga" > > Case 4: ConvertDigit = "empat" > > Case 5: ConvertDigit = "lima" > > Case 6: ConvertDigit = "enam" > > Case 7: ConvertDigit = "tujuh" > > Case 8: ConvertDigit = "delapan" > > Case 9: ConvertDigit = "sembilan" > > Case Else: ConvertDigit = "" > > End Select > > > > End Function > > > > Private Function ConvertRatus(ByVal MyNumber) > > Dim Result As String > > > > ' Exit if there is nothing to convert. > > If Val(MyNumber) = 0 Then Exit Function > > > > ' Append leading zeros to number. > > MyNumber = Right("000" & MyNumber, 3) > > > > ' Do we have a ratus place digit to > > convert? > > If left(MyNumber, 1) <> "0" Then > > Result = ConvertDigit(left(MyNumber, 1)) > > & > > " ratus " > > End If > > > > ' Do we have a puluh place digit to > > convert? > > If Mid(MyNumber, 2, 1) <> "0" Then > > Result = Result & > > ConvertPuluh(Mid(MyNumber, 2)) > > Else > > ' If not, then convert the ones place > > digit. > > Result = Result & > > ConvertDigit(Mid(MyNumber, 3)) > > End If > > > > ConvertRatus = Trim(Result) > > End Function > > > > > > Private Function ConvertPuluh(ByVal MyPuluh) > > Dim Result As String > > > > ' Is value between 10 and 19? > > If Val(left(MyPuluh, 1)) = 1 Then > > Select Case Val(MyPuluh) > > Case 10: Result = "sepuluh" > > Case 11: Result = "sebelas" > > Case 12: Result = "dua belas" > > Case 13: Result = "tiga belas" > > Case 14: Result = "empat belas" > > Case 15: Result = "lima belas" > > Case 16: Result = "enam belas" > > Case 17: Result = "tujuh belas" > > Case 18: Result = "delap belas" > > Case 19: Result = "sembilan belas" > > Case Else > > End Select > > Else > > ' .. otherwise it's between 20 and 99. > > Select Case Val(left(MyPuluh, 1)) > > Case 2: Result = "dua puluh " > > Case 3: Result = "tiga puluh " > > Case 4: Result = "empat puluh " > > Case 5: Result = "lima puluh " > > Case 6: Result = "enam puluh " > > Case 7: Result = "tujuh puluh " > > Case 8: Result = "delapan puluh " > > Case 9: Result = "sembilan puluh " > > Case Else > > End Select > > > > ' Convert ones place digit. > > Result = Result & > > ConvertDigit(Right(MyPuluh, 1)) > > End If > > > > ConvertPuluh = Result > > End Function > > > > > > __________________________________________________ > > Do You Yahoo!? > > Tired of spam? Yahoo! Mail has the best spam > > protection around > > http://mail.yahoo.com > > > > > > > > > > > __________________________________________________ > Do You Yahoo!? > Tired of spam? Yahoo! Mail has the best spam protection around > http://mail.yahoo.com > Yahoo! Groups Links <*> To visit your group on the web, go to: http://groups.yahoo.com/group/ilkom_usu/ <*> 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/
