From: "Ivan Leonardo" <ivan@pttdp.com>
To: <belajar-access@yahoogroups.com>
Sent: Friday, July 03, 2009 1:05 PM
Subject: Re: [belajar-access] terbilang in English...
> Campur nih sama yg indo, cari yang terbil_eng
>
> Option Compare Database
>
> Function TERBIL_INDO(ByVal Angkanya)
> Dim Temp
> Dim Rupiahnya, Sennya
> Dim DecimalPlace, Count
>
> ReDim place(9) As String
> ' untuk nilai count=count+1, Angkanya dibagi atas 3 digit
> place(2) = "RIBU "
> place(3) = "JUTA "
> place(4) = "MILYAR "
> place(5) = "TRILYUN "
> ' ubah jadi string , dan hilangkan spasi.
>
>
> Angkanya = Trim(STR(Angkanya))
>
> ' cari sen.
> DecimalPlace = InStr(Angkanya, ".")
>
> ' bila ketemu sen...
> If DecimalPlace > 0 Then
> ' ubah ke sen
> Temp = Left(Mid(Angkanya, DecimalPlace + 1) & "00", 2)
> Sennya = ConvertPuluhan(Temp)
>
> ' buang sen dari Angkanya.
> Angkanya = Trim(Left(Angkanya, DecimalPlace - 1))
> End If
>
> Count = 1
> ' ini yang repot, soalnya seribu bukannya satu ribu
> Do While Angkanya <> ""
> ' jadi pakai if dengan count=2 dan angkanya=1 saja
> ' tapi bila angkanya diatas 999 trilyun harus tambah lagi if
> ' untuk count = 7
> If Right(Angkanya, 3) = 1 And Count = 2 Then
> Temp = "SE"
> Else
> ' Ubah setiap 3 digit ke terbilang di Indonesia
> Temp = ConvertRatusan(Right(Angkanya, 3))
> End If
>
> ' ini dia hasilnya.....
> If Temp <> "" Then Rupiahnya = Temp & place(Count) & Rupiahnya
>
> If Len(Angkanya) > 3 Then
> ' buang 3 angka terakhir dari Angkanya dan count boleh
> tambah.
> Angkanya = Left(Angkanya, Len(Angkanya) - 3)
> Else
> Angkanya = ""
> End If
>
> Count = Count + 1
> Loop
>
> ' kosongkan nilai rupiahnya.
> Select Case Rupiahnya
> Case ""
> Rupiahnya = "NIL RUPIAH "
> Case "One"
> Rupiahnya = "SATU RUPIAH"
> Case Else
> Rupiahnya = Rupiahnya & " RUPIAH"
> End Select
>
> ' kosongkan nilai sennya.
> Select Case Sennya
> Case ""
> Sennya = " "
> Case "One"
> Sennya = "SATU SEN"
> Case Else
> Sennya = " DAN " & Sennya & " SEN"
> End Select
>
> TERBIL_INDO = Rupiahnya & Sennya
> End Function
> Function TERBIL_INDOUSD(ByVal Angkanya)
> Dim Temp
> Dim Rupiahnya, Sennya
> Dim DecimalPlace, Count
>
> ReDim place(9) As String
> ' untuk nilai count=count+1, Angkanya dibagi atas 3 digit
> place(2) = "RIBU "
> place(3) = "JUTA "
> place(4) = "MILYAR "
> place(5) = "TRILYUN "
>
> ' ubah jadi string , dan hilangkan spasi.
>
>
> Angkanya = Trim(STR(Angkanya))
>
> ' cari sen.
> DecimalPlace = InStr(Angkanya, ".")
>
> ' bila ketemu sen...
> If DecimalPlace > 0 Then
> ' ubah ke sen
> Temp = Left(Mid(Angkanya, DecimalPlace + 1) & "00", 2)
> Sennya = ConvertPuluhan(Temp)
>
> ' buang sen dari Angkanya.
> Angkanya = Trim(Left(Angkanya, DecimalPlace - 1))
> End If
>
> Count = 1
> ' ini yang repot, soalnya seribu bukannya satu ribu
> Do While Angkanya <> ""
> ' jadi pakai if dengan count=2 dan angkanya=1 saja
> ' tapi bila angkanya diatas 999 trilyun harus tambah lagi if
> ' untuk count = 7
> If Right(Angkanya, 3) = 1 And Count = 2 Then
> Temp = "SE"
> Else
> ' Ubah setiap 3 digit ke terbilang di Indonesia
> Temp = ConvertRatusan(Right(Angkanya, 3))
> End If
>
> ' ini dia hasilnya.....
> If Temp <> "" Then Rupiahnya = Temp & place(Count) & Rupiahnya
>
> If Len(Angkanya) > 3 Then
> ' buang 3 angka terakhir dari Angkanya dan count boleh
> tambah.
> Angkanya = Left(Angkanya, Len(Angkanya) - 3)
> Else
> Angkanya = ""
> End If
>
> Count = Count + 1
> Loop
>
> ' kosongkan nilai rupiahnya.
> Select Case Rupiahnya
> Case ""
> Rupiahnya = "NIL "
> Case "One"
> Rupiahnya = "SATU "
> Case Else
> Rupiahnya = Rupiahnya
> End Select
>
> ' kosongkan nilai sennya.
> Select Case Sennya
> Case ""
> Sennya = " "
> Case "One"
> Sennya = "SATU SEN"
> Case Else
> Sennya = " DAN " & Sennya & " SEN"
> End Select
>
> TERBIL_INDOUSD = Rupiahnya & Sennya
> End Function
>
>
> Private Function ConvertSatuan(ByVal Satuannya)
> Select Case VAL(Satuannya)
> Case 1: ConvertSatuan = "SATU "
> Case 2: ConvertSatuan = "DUA "
> Case 3: ConvertSatuan = "TIGA "
> Case 4: ConvertSatuan = "EMPAT "
> Case 5: ConvertSatuan = "LIMA "
> Case 6: ConvertSatuan = "ENAM "
> Case 7: ConvertSatuan = "TUJUH "
> Case 8: ConvertSatuan = "DELAPAN "
> Case 9: ConvertSatuan = "SEMBILAN "
> Case Else: ConvertSatuan = ""
> End Select
>
> End Function
>
> Private Function ConvertRatusan(ByVal Angkanya)
> Dim Result As String
>
> ' Exit if there is nothing to convert.
> If VAL(Angkanya) = 0 Then Exit Function
>
> ' Append leading zeros to number.
> Angkanya = Right("000" & Angkanya, 3)
>
> ' Do we have a hundreds place digit to convert?
> If Left(Angkanya, 1) <> "0" Then
> Result = ConvertSeratus(Left(Angkanya, 1)) & "RATUS" &
Chr$(32)
> End If
>
> ' Do we have a tens place digit to convert?
> If Mid(Angkanya, 2, 1) <> "0" Then
> Result = Result & ConvertPuluhan(Mid(Angkanya, 2))
> Else
> ' If not, then convert the ones place digit.
> Result = Result & ConvertSatuan(Mid(Angkanya, 3))
> End If
>
> ConvertRatusan = Result
> End Function
>
>
> Private Function ConvertPuluhan(ByVal Puluhannya)
> Dim Result As String
>
> ' untuk bilangan sebelas,, kalau english itu juga ada dua
> ' eleventh dan twelve
> If VAL(Left(Puluhannya, 1)) = 1 Then
> Select Case VAL(Puluhannya)
> 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 = "DELAPAN BELAS "
> Case 19: Result = "SEMBILAN BELAS "
> Case Else
> End Select
> Else
> ' .. juga untuk sisanya.
> Select Case VAL(Left(Puluhannya, 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
>
> ' tambahkan dengan satuannya.
> Result = Result & ConvertSatuan(Right(Puluhannya, 1))
> End If
>
> ConvertPuluhan = Result
> End Function
>
> Private Function ConvertSeratus(ByVal Ratusannya)
> ' ini untuk ratusan dimana satu ratus diganti seratus
> Select Case VAL(Ratusannya)
> Case 1: ConvertSeratus = "SE"
> Case 2: ConvertSeratus = "DUA "
> Case 3: ConvertSeratus = "TIGA "
> Case 4: ConvertSeratus = "EMPAT "
> Case 5: ConvertSeratus = "LIMA "
> Case 6: ConvertSeratus = "ENAM "
> Case 7: ConvertSeratus = "TUJUH "
> Case 8: ConvertSeratus = "DELAPAN "
> Case 9: ConvertSeratus = "SEMBILAN "
> Case Else: ConvertSeratus = ""
> End Select
>
> End Function
>
> Function TERBIL_ENG(ByVal MyNumber)
> Dim Temp
> Dim dollars, Cents
> Dim DecimalPlace, Count
>
> ReDim place(9) As String
> place(2) = " Thousand "
> place(3) = " Million "
> place(4) = " Billion "
> place(5) = " Trillion "
>
> ' 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 cents
> Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
> Cents = ConvertTens(Temp)
>
> ' Strip off cents from remainder to convert.
> MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
> End If
>
> Count = 1
> Do While MyNumber <> ""
> ' Convert last 3 digits of MyNumber to English dollars.
> Temp = ConvertHundreds(Right(MyNumber, 3))
> If Temp <> "" Then dollars = Temp & place(Count) & dollars
> 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 dollars.
> Select Case dollars
> Case ""
> dollars = "No"
> Case "One"
> dollars = "One"
> End Select
>
> ' Clean up cents.
> Select Case Cents
> Case ""
> Cents = " And No Cents"
> Case "One"
> Cents = " And One Cent"
> Case Else
> Cents = " And " & Cents & " Cents"
> End Select
>
> TERBIL_ENG = dollars & Cents
> End Function
>
>
> Private Function ConvertDigit(ByVal MyDigit)
> Select Case VAL(MyDigit)
> Case 1: ConvertDigit = "One"
> Case 2: ConvertDigit = "Two"
> Case 3: ConvertDigit = "Three"
> Case 4: ConvertDigit = "Four"
> Case 5: ConvertDigit = "Five"
> Case 6: ConvertDigit = "Six"
> Case 7: ConvertDigit = "Seven"
> Case 8: ConvertDigit = "Eight"
> Case 9: ConvertDigit = "Nine"
> Case Else: ConvertDigit = ""
> End Select
>
> End Function
>
> Private Function ConvertHundreds(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 hundreds place digit to convert?
> If Left(MyNumber, 1) <> "0" Then
> Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
> End If
>
> ' Do we have a tens place digit to convert?
> If Mid(MyNumber, 2, 1) <> "0" Then
> Result = Result & ConvertTens(Mid(MyNumber, 2))
> Else
> ' If not, then convert the ones place digit.
> Result = Result & ConvertDigit(Mid(MyNumber, 3))
> End If
>
> ConvertHundreds = Trim(Result)
> End Function
>
>
> Private Function ConvertTens(ByVal MyTens)
> Dim Result As String
>
> ' Is value between 10 and 19?
> If VAL(Left(MyTens, 1)) = 1 Then
> Select Case VAL(MyTens)
> Case 10: Result = "Ten"
> Case 11: Result = "Eleven"
> Case 12: Result = "Twelve"
> Case 13: Result = "Thirteen"
> Case 14: Result = "Fourteen"
> Case 15: Result = "Fifteen"
> Case 16: Result = "Sixteen"
> Case 17: Result = "Seventeen"
> Case 18: Result = "Eighteen"
> Case 19: Result = "Nineteen"
> Case Else
> End Select
> Else
> ' .. otherwise it's between 20 and 99.
> Select Case VAL(Left(MyTens, 1))
> Case 2: Result = "Twenty "
> Case 3: Result = "Thirty "
> Case 4: Result = "Forty "
> Case 5: Result = "Fifty "
> Case 6: Result = "Sixty "
> Case 7: Result = "Seventy "
> Case 8: Result = "Eighty "
> Case 9: Result = "Ninety "
> Case Else
> End Select
>
> ' Convert ones place digit.
> Result = Result & ConvertDigit(Right(MyTens, 1))
> End If
>
> ConvertTens = Result
> End Function
>
>
> --------------------------------------------------------------------------
-
> This message contains confidential information and is intended only for
the individual named. If you are not the named addressee you should not
disseminate, distribute or copy this e-mail. Please notify the sender
immediately by e-mail if you have received this e-mail by mistake and delete
this e-mail from your system. E-mail transmission cannot be guaranteed to be
secure or error-free as information could be intercepted, corrupted, lost,
destroyed, arrive late or incomplete, or contain viruses. The sender
therefore does not accept liability for any errors or omissions in the
contents of this message, which arise as a result of e-mail transmission. If
verification is required please request a hard-copy version.
>
>
>
> ------------------------------------
>
> SPAM IS PROHIBITEDYahoo! Groups Links
>
> <*> To visit your group on the web, go to:
> http://groups.yahoo.com/group/belajar-access/
>
> <*> Your email settings:
> Individual Email | Traditional
>
> <*> To change settings online go to:
> http://groups.yahoo.com/group/belajar-access/join
> (Yahoo! ID required)
>
> <*> To change settings via email:
> mailto:belajar-access-digest@yahoogroups.com
> mailto:belajar-access-fullfeatured@yahoogroups.com
>
> <*> To unsubscribe from this group, send an email to:
> belajar-access-unsubscribe@yahoogroups.com
>
> <*> Your use of Yahoo! Groups is subject to:
> http://docs.yahoo.com/info/terms/
>
No comments:
Post a Comment