2 Messages
Digest #2766
Messages
Mon Sep 1, 2014 7:59 am (PDT) . Posted by:
"Didi An naufal" didiannaufal
Misalkan data terletak di Sel A1, bisa masukan formula ini =TEXT(SUBSTITUTE(A1;"-";"");"0000000000000")
Semoga membantu.
Didi Rusidi
Pada Senin, 25 Agustus 2014 21:04, "girlsaye@ymail.com [XL-mania]" <XL-mania@yahoogroups.com> menulis:
Dear para pakar excell mania,
Mohon dibantu saya untuk memecahkan case sbb.
Misal No rekenening : 0056-27-45-12345
Dari data no rekening tsb di atas bagaimana sy menghilangkan karakter minus (-) tanpa menghilangakan karakter depan (0056). Karena sy sdh mencoba menggunakan control replace untuk menghilang karakter (-), tetapi karakter yg didepan juga ikut hilang (angaka 00). Atas bantuannya, sy sampaikan terima kasih
Regards
Ningrum
Powered by Telkomsel BlackBerry®
Semoga membantu.
Didi Rusidi
Pada Senin, 25 Agustus 2014 21:04, "girlsaye@ymail.com [XL-mania]" <XL-mania@yahoogroups.com> menulis:
Dear para pakar excell mania,
Mohon dibantu saya untuk memecahkan case sbb.
Misal No rekenening : 0056-27-45-12345
Dari data no rekening tsb di atas bagaimana sy menghilangkan karakter minus (-) tanpa menghilangakan karakter depan (0056). Karena sy sdh mencoba menggunakan control replace untuk menghilang karakter (-), tetapi karakter yg didepan juga ikut hilang (angaka 00). Atas bantuannya, sy sampaikan terima kasih
Regards
Ningrum
Powered by Telkomsel BlackBerry®
Mon Sep 1, 2014 8:07 am (PDT) . Posted by:
"Iksan Bondang" xanbondang
Copykan aja ke Module
lalu pada sheet ditulis rumus fungsi terbilang.
contoh ditulis di Cell A2: =terbilang(A1;1;"Rupiah")
A1 = cell untuk angka
angka 1 = untuk huruf besar semua
angka 2 = untuk huruf kecil semua
angka 3 = untuk huruf besar pada tiap kata
"Rupiah" = untuk mata uang rupiah, tidak dipakai pun tak apa-apa atau mata uang manapun (dolar, ringgit, dsb)
'Fungsi Terbilang dengan VBA untuk MS Office
'Ditulis oleh Iksan
'Fungsi penterjemahan masing-masing angka
Private Function KeKata(Nomor)
TrjKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
KeKata = TrjKata(Nomor)
End Function
'Mulai penulisan Fungsi Terbilang
Public Function terbilang(Nilai_Angka, Optional Style = 4, Optional Satuan = "")
Angka = Fix(Abs(Nilai_Angka))
'Desimal dibelakang koma
des1 = Mid(Abs(Nilai_Angka), Len(Angka) + 2, 1)
des2 = Mid(Abs(Nilai_Angka), Len(Angka) + 3, 1)
If des2 = "" Then
If des1 = "" Or des1 = "0" Then
Koma = ""
Else
Koma = " koma " & KeKata(des1)
End If
ElseIf des2 = "0" Then
If des1 = "0" Then
Koma = ""
ElseIf des1 = "1" Then
Koma = " koma sepuluh"
Else
Koma = " koma " & KeKata(des1) & " puluh"
End If
Else
If des1 = "0" Then
Koma = " koma nol " & KeKata(des2)
ElseIf des1 = "1" Then
If des2 = "1" Then
Koma = " koma sebelas"
Else
Koma = " koma " & KeKata(des2) & " belas"
End If
Else
Koma = " koma " & KeKata(des1) & " puluh " & KeKata(des2)
End If
End If
'Misahin Angka
No1 = Left(Right(Angka, 1), 1)
No2 = Left(Right(Angka, 2), 1)
No3 = Left(Right(Angka, 3), 1)
No4 = Left(Right(Angka, 4), 1)
No5 = Left(Right(Angka, 5), 1)
No6 = Left(Right(Angka, 6), 1)
No7 = Left(Right(Angka, 7), 1)
No8 = Left(Right(Angka, 8), 1)
No9 = Left(Right(Angka, 9), 1)
No10 = Left(Right(Angka, 10), 1)
No11 = Left(Right(Angka, 11), 1)
No12 = Left(Right(Angka, 12), 1)
No13 = Left(Right(Angka, 13), 1)
No14 = Left(Right(Angka, 14), 1)
No15 = Left(Right(Angka, 15), 1)
'Satuan
If Len(Angka) >= 1 Then
If Len(Angka) = 1 And No1 = 1 Then
Nomor1 = "satu"
ElseIf Len(Angka) = 1 And No1 = 0 Then
Nomor1 = "Nol"
ElseIf No2 = "1" Then
If No1 = "1" Then
Nomor1 = "sebelas"
ElseIf No1 = "0" Then
Nomor1 = "sepuluh"
Else
Nomor1 = KeKata(No1) & " belas"
End If
Else
Nomor1 = KeKata(No1)
End If
Else
Nomor1 = ""
End If
'Puluhan
If Len(Angka) >= 2 Then
If No2 = 1 Or No2 = "0" Then
Nomor2 = ""
Else
Nomor2 = KeKata(No2) & " puluh "
End If
Else
Nomor2 = ""
End If
'Ratusan
If Len(Angka) >= 3 Then
If No3 = "1" Then
Nomor3 = "seratus "
ElseIf No3 = "0" Then
Nomor3 = ""
Else
Nomor3 = KeKata(No3) & " ratus "
End If
Else
Nomor3 = ""
End If
'Ribuan
If Len(Angka) >= 4 Then
If No6 = "0" And No5 = "0" And No4 = "0" Then
Nomor4 = ""
ElseIf (No4 = "1" And Len(Angka) = 4) Or (No6 = "0" And No5 = "0" And No4 = "1") Then
Nomor4 = "seribu "
ElseIf No5 = "1" Then
If No4 = "1" Then
Nomor4 = "sebelas ribu "
ElseIf No4 = "0" Then
Nomor4 = "sepuluh ribu "
Else
Nomor4 = KeKata(No4) & " belas ribu "
End If
Else
Nomor4 = KeKata(No4) & " ribu "
End If
Else
Nomor4 = ""
End If
'Puluhan ribu
If Len(Angka) >= 5 Then
If No5 = "1" Or No5 = "0" Then
Nomor5 = ""
Else
Nomor5 = KeKata(No5) & " puluh "
End If
Else
Nomor5 = ""
End If
'Ratusan Ribu
If Len(Angka) >= 6 Then
If No6 = "1" Then
Nomor6 = "seratus "
ElseIf No6 = "0" Then
Nomor6 = ""
Else
Nomor6 = KeKata(No6) & " ratus "
End If
Else
Nomor6 = ""
End If
'Jutaan
If Len(Angka) >= 7 Then
If No9 = "0" And No8 = "0" And No7 = "0" Then
Nomor7 = ""
ElseIf No7 = "1" And Len(Angka) = 7 Then
Nomor7 = "satu juta "
ElseIf No8 = "1" Then
If No7 = "1" Then
Nomor7 = "sebelas juta "
ElseIf No7 = "0" Then
Nomor7 = "sepuluh juta "
Else
Nomor7 = KeKata(No7) & " belas juta "
End If
Else
Nomor7 = KeKata(No7) & " juta "
End If
Else
Nomor7 = ""
End If
'Puluhan juta
If Len(Angka) >= 8 Then
If No8 = "1" Or No8 = "0" Then
Nomor8 = ""
Else
Nomor8 = KeKata(No8) & " puluh "
End If
Else
Nomor8 = ""
End If
'Ratusan juta
If Len(Angka) >= 9 Then
If No9 = "1" Then
Nomor9 = "seratus "
ElseIf No9 = "0" Then
Nomor9 = ""
Else
Nomor9 = KeKata(No9) & " ratus "
End If
Else
Nomor9 = ""
End If
'Milyar
If Len(Angka) >= 10 Then
If No12 = "0" And No11 = "0" And No10 = "0" Then
Nomor10 = ""
ElseIf No10 = "1" And Len(Angka) = 10 Then
Nomor10 = "satu milyar "
ElseIf No11 = "1" Then
If No10 = "1" Then
Nomor10 = "sebelas milyar "
ElseIf No10 = "0" Then
Nomor10 = "sepuluh milyar "
Else
Nomor10 = KeKata(No10) & " belas milyar "
End If
Else
Nomor10 = KeKata(No10) & " milyar "
End If
Else
Nomor10 = ""
End If
'Puluhan Milyar
If Len(Angka) >= 11 Then
If No11 = "1" Or No11 = "0" Then
Nomor11 = ""
Else
Nomor11 = KeKata(No11) & " puluh "
End If
Else
Nomor11 = ""
End If
'Ratusan Milyar
If Len(Angka) >= 12 Then
If No12 = "1" Then
Nomor12 = "seratus "
ElseIf No12 = "0" Then
Nomor12 = ""
Else
Nomor12 = KeKata(No12) & " ratus "
End If
Else
Nomor12 = ""
End If
'Triliun
If Len(Angka) >= 13 Then
If No15 = "0" And No14 = "0" And No13 = "0" Then
Nomor13 = ""
ElseIf No13 = "1" And Len(Angka) = 13 Then
Nomor13 = "satu triliun "
ElseIf No14 = "1" Then
If No13 = "1" Then
Nomor13 = "sebelas triliun "
ElseIf No13 = "0" Then
Nomor13 = "sepuluh triliun "
Else
Nomor13 = KeKata(No13) & " belas triliun "
End If
Else
Nomor13 = KeKata(No13) & " triliun "
End If
Else
Nomor13 = ""
End If
'Puluhan triliun
If Len(Angka) >= 14 Then
If No14 = "1" Or No14 = "0" Then
Nomor14 = ""
Else
Nomor14 = KeKata(No14) & " puluh "
End If
Else
Nomor14 = ""
End If
'Ratusan triliun
If Len(Angka) >= 15 Then
If No15 = "1" Then
Nomor15 = "seratus "
ElseIf No15 = "0" Then
Nomor15 = ""
Else
Nomor15 = KeKata(No15) & " ratus "
End If
Else
Nomor15 = ""
End If
If Len(Angka) > 15 Then
bilang = "Digit Angka Terlalu Banyak"
Else
If IsNull(Nilai_Angka) Then
bilang = ""
ElseIf Nilai_Angka < 0 Then
bilang = "minus " & Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
Else
bilang = Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
End If
End If
If Style = 4 Then
terbilang = StrConv(Left(bilang, 1), 1) & StrConv(Mid(bilang, 2, 1000), 2)
Else
terbilang = StrConv(bilang, Style)
End If
terbilang = Replace(terbilang, " ", " ", 1, 1000, vbTextCompare)
End Function
Pada Senin, 25 Agustus 2014 21:03, "Edhie Wibowo edhiewibowo@gmail.com [XL-mania]" <XL-mania@yahoogroups.com> menulis:
Dear temans,
saya mau tanya nih, ttg macro penulisan bilangan utk uang (rupiah),
dapet dari google dalam dollar, kemudian saya modifikasi jadi rupiah.
Sejauh ini sih macronya berhasil dgn baik, hanya ketika ada angka 100,
tidak bisa membacanya "seratus" tapi satu ratus, juga 10, tidak dibaca
"sepuluh", tapi satu puluh. Gimana spy bisa terbaca cara Indonesia?
Mohon solusinya dari para master. Terima kasih banyak.
-------------------------------------------
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " ribu "
Place(3) = " juta "
Place(4) = " milyar "
Place(5) = " trilyun "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "Tidak ada uang"
Case "One"
Dollars = "satu rupiah"
Case Else
Dollars = Dollars & " rupiah"
End Select
Select Case Cents
Case ""
Cents = " "
Case "One"
Cents = " dan satu sen"
Case Else
Cents = " and " & Cents & " sen"
End Select
SpellNumber = Dollars & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " ratus "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
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 ' If value between 20-99...
Select Case Val(Left(TensText, 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
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "satu"
Case 2: GetDigit = "dua"
Case 3: GetDigit = "tiga"
Case 4: GetDigit = "empat"
Case 5: GetDigit = "lima"
Case 6: GetDigit = "enam"
Case 7: GetDigit = "tujuh"
Case 8: GetDigit = "delapan"
Case 9: GetDigit = "sembilan"
Case Else: GetDigit = ""
End Select
End Function
----------------------------------------------------------
--
Jabat hangat,
Edhie Wibowo
"Vision Shows the Way, Passion Sustains the Journey"
lalu pada sheet ditulis rumus fungsi terbilang.
contoh ditulis di Cell A2: =terbilang(A1;1;"Rupiah")
A1 = cell untuk angka
angka 1 = untuk huruf besar semua
angka 2 = untuk huruf kecil semua
angka 3 = untuk huruf besar pada tiap kata
"Rupiah" = untuk mata uang rupiah, tidak dipakai pun tak apa-apa atau mata uang manapun (dolar, ringgit, dsb)
'Fungsi Terbilang dengan VBA untuk MS Office
'Ditulis oleh Iksan
'Fungsi penterjemahan masing-masing angka
Private Function KeKata(Nomor)
TrjKata = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", "tujuh", "delapan", "sembilan")
KeKata = TrjKata(Nomor)
End Function
'Mulai penulisan Fungsi Terbilang
Public Function terbilang(Nilai_Angka, Optional Style = 4, Optional Satuan = "")
Angka = Fix(Abs(Nilai_Angka))
'Desimal dibelakang koma
des1 = Mid(Abs(Nilai_Angka), Len(Angka) + 2, 1)
des2 = Mid(Abs(Nilai_Angka), Len(Angka) + 3, 1)
If des2 = "" Then
If des1 = "" Or des1 = "0" Then
Koma = ""
Else
Koma = " koma " & KeKata(des1)
End If
ElseIf des2 = "0" Then
If des1 = "0" Then
Koma = ""
ElseIf des1 = "1" Then
Koma = " koma sepuluh"
Else
Koma = " koma " & KeKata(des1) & " puluh"
End If
Else
If des1 = "0" Then
Koma = " koma nol " & KeKata(des2)
ElseIf des1 = "1" Then
If des2 = "1" Then
Koma = " koma sebelas"
Else
Koma = " koma " & KeKata(des2) & " belas"
End If
Else
Koma = " koma " & KeKata(des1) & " puluh " & KeKata(des2)
End If
End If
'Misahin Angka
No1 = Left(Right(Angka, 1), 1)
No2 = Left(Right(Angka, 2), 1)
No3 = Left(Right(Angka, 3), 1)
No4 = Left(Right(Angka, 4), 1)
No5 = Left(Right(Angka, 5), 1)
No6 = Left(Right(Angka, 6), 1)
No7 = Left(Right(Angka, 7), 1)
No8 = Left(Right(Angka, 8), 1)
No9 = Left(Right(Angka, 9), 1)
No10 = Left(Right(Angka, 10), 1)
No11 = Left(Right(Angka, 11), 1)
No12 = Left(Right(Angka, 12), 1)
No13 = Left(Right(Angka, 13), 1)
No14 = Left(Right(Angka, 14), 1)
No15 = Left(Right(Angka, 15), 1)
'Satuan
If Len(Angka) >= 1 Then
If Len(Angka) = 1 And No1 = 1 Then
Nomor1 = "satu"
ElseIf Len(Angka) = 1 And No1 = 0 Then
Nomor1 = "Nol"
ElseIf No2 = "1" Then
If No1 = "1" Then
Nomor1 = "sebelas"
ElseIf No1 = "0" Then
Nomor1 = "sepuluh"
Else
Nomor1 = KeKata(No1) & " belas"
End If
Else
Nomor1 = KeKata(No1)
End If
Else
Nomor1 = ""
End If
'Puluhan
If Len(Angka) >= 2 Then
If No2 = 1 Or No2 = "0" Then
Nomor2 = ""
Else
Nomor2 = KeKata(No2) & " puluh "
End If
Else
Nomor2 = ""
End If
'Ratusan
If Len(Angka) >= 3 Then
If No3 = "1" Then
Nomor3 = "seratus "
ElseIf No3 = "0" Then
Nomor3 = ""
Else
Nomor3 = KeKata(No3) & " ratus "
End If
Else
Nomor3 = ""
End If
'Ribuan
If Len(Angka) >= 4 Then
If No6 = "0" And No5 = "0" And No4 = "0" Then
Nomor4 = ""
ElseIf (No4 = "1" And Len(Angka) = 4) Or (No6 = "0" And No5 = "0" And No4 = "1") Then
Nomor4 = "seribu "
ElseIf No5 = "1" Then
If No4 = "1" Then
Nomor4 = "sebelas ribu "
ElseIf No4 = "0" Then
Nomor4 = "sepuluh ribu "
Else
Nomor4 = KeKata(No4) & " belas ribu "
End If
Else
Nomor4 = KeKata(No4) & " ribu "
End If
Else
Nomor4 = ""
End If
'Puluhan ribu
If Len(Angka) >= 5 Then
If No5 = "1" Or No5 = "0" Then
Nomor5 = ""
Else
Nomor5 = KeKata(No5) & " puluh "
End If
Else
Nomor5 = ""
End If
'Ratusan Ribu
If Len(Angka) >= 6 Then
If No6 = "1" Then
Nomor6 = "seratus "
ElseIf No6 = "0" Then
Nomor6 = ""
Else
Nomor6 = KeKata(No6) & " ratus "
End If
Else
Nomor6 = ""
End If
'Jutaan
If Len(Angka) >= 7 Then
If No9 = "0" And No8 = "0" And No7 = "0" Then
Nomor7 = ""
ElseIf No7 = "1" And Len(Angka) = 7 Then
Nomor7 = "satu juta "
ElseIf No8 = "1" Then
If No7 = "1" Then
Nomor7 = "sebelas juta "
ElseIf No7 = "0" Then
Nomor7 = "sepuluh juta "
Else
Nomor7 = KeKata(No7) & " belas juta "
End If
Else
Nomor7 = KeKata(No7) & " juta "
End If
Else
Nomor7 = ""
End If
'Puluhan juta
If Len(Angka) >= 8 Then
If No8 = "1" Or No8 = "0" Then
Nomor8 = ""
Else
Nomor8 = KeKata(No8) & " puluh "
End If
Else
Nomor8 = ""
End If
'Ratusan juta
If Len(Angka) >= 9 Then
If No9 = "1" Then
Nomor9 = "seratus "
ElseIf No9 = "0" Then
Nomor9 = ""
Else
Nomor9 = KeKata(No9) & " ratus "
End If
Else
Nomor9 = ""
End If
'Milyar
If Len(Angka) >= 10 Then
If No12 = "0" And No11 = "0" And No10 = "0" Then
Nomor10 = ""
ElseIf No10 = "1" And Len(Angka) = 10 Then
Nomor10 = "satu milyar "
ElseIf No11 = "1" Then
If No10 = "1" Then
Nomor10 = "sebelas milyar "
ElseIf No10 = "0" Then
Nomor10 = "sepuluh milyar "
Else
Nomor10 = KeKata(No10) & " belas milyar "
End If
Else
Nomor10 = KeKata(No10) & " milyar "
End If
Else
Nomor10 = ""
End If
'Puluhan Milyar
If Len(Angka) >= 11 Then
If No11 = "1" Or No11 = "0" Then
Nomor11 = ""
Else
Nomor11 = KeKata(No11) & " puluh "
End If
Else
Nomor11 = ""
End If
'Ratusan Milyar
If Len(Angka) >= 12 Then
If No12 = "1" Then
Nomor12 = "seratus "
ElseIf No12 = "0" Then
Nomor12 = ""
Else
Nomor12 = KeKata(No12) & " ratus "
End If
Else
Nomor12 = ""
End If
'Triliun
If Len(Angka) >= 13 Then
If No15 = "0" And No14 = "0" And No13 = "0" Then
Nomor13 = ""
ElseIf No13 = "1" And Len(Angka) = 13 Then
Nomor13 = "satu triliun "
ElseIf No14 = "1" Then
If No13 = "1" Then
Nomor13 = "sebelas triliun "
ElseIf No13 = "0" Then
Nomor13 = "sepuluh triliun "
Else
Nomor13 = KeKata(No13) & " belas triliun "
End If
Else
Nomor13 = KeKata(No13) & " triliun "
End If
Else
Nomor13 = ""
End If
'Puluhan triliun
If Len(Angka) >= 14 Then
If No14 = "1" Or No14 = "0" Then
Nomor14 = ""
Else
Nomor14 = KeKata(No14) & " puluh "
End If
Else
Nomor14 = ""
End If
'Ratusan triliun
If Len(Angka) >= 15 Then
If No15 = "1" Then
Nomor15 = "seratus "
ElseIf No15 = "0" Then
Nomor15 = ""
Else
Nomor15 = KeKata(No15) & " ratus "
End If
Else
Nomor15 = ""
End If
If Len(Angka) > 15 Then
bilang = "Digit Angka Terlalu Banyak"
Else
If IsNull(Nilai_Angka) Then
bilang = ""
ElseIf Nilai_Angka < 0 Then
bilang = "minus " & Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
Else
bilang = Trim(Nomor15 & Nomor14 & Nomor13 & Nomor12 & Nomor11 & Nomor10 & Nomor9 & Nomor8 & Nomor7 _
& Nomor6 & Nomor5 & Nomor4 & Nomor3 & Nomor2 & Nomor1 & Koma & " " & Satuan)
End If
End If
If Style = 4 Then
terbilang = StrConv(Left(bilang, 1), 1) & StrConv(Mid(bilang, 2, 1000), 2)
Else
terbilang = StrConv(bilang, Style)
End If
terbilang = Replace(terbilang, " ", " ", 1, 1000, vbTextCompare)
End Function
Pada Senin, 25 Agustus 2014 21:03, "Edhie Wibowo edhiewibowo@gmail.com [XL-mania]" <XL-mania@yahoogroups.com> menulis:
Dear temans,
saya mau tanya nih, ttg macro penulisan bilangan utk uang (rupiah),
dapet dari google dalam dollar, kemudian saya modifikasi jadi rupiah.
Sejauh ini sih macronya berhasil dgn baik, hanya ketika ada angka 100,
tidak bisa membacanya "seratus" tapi satu ratus, juga 10, tidak dibaca
"sepuluh"
Mohon solusinya dari para master. Terima kasih banyak.
------------
Option Explicit
'Main Function
Function SpellNumber(
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " ribu "
Place(3) = " juta "
Place(4) = " milyar "
Place(5) = " trilyun "
' String representation of amount.
MyNumber = Trim(Str(MyNumber)
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, "."
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(
"00"
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "Tidak ada uang"
Case "One"
Dollars = "satu rupiah"
Case Else
Dollars = Dollars & " rupiah"
End Select
Select Case Cents
Case ""
Cents = " "
Case "One"
Cents = " dan satu sen"
Case Else
Cents = " and " & Cents & " sen"
End Select
SpellNumber = Dollars & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(
Else
Result = Result & GetDigit(Mid(
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
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 ' If value between 20-99...
Select Case Val(Left(TensText, 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
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "satu"
Case 2: GetDigit = "dua"
Case 3: GetDigit = "tiga"
Case 4: GetDigit = "empat"
Case 5: GetDigit = "lima"
Case 6: GetDigit = "enam"
Case 7: GetDigit = "tujuh"
Case 8: GetDigit = "delapan"
Case 9: GetDigit = "sembilan"
Case Else: GetDigit = ""
End Select
End Function
------------
--
Jabat hangat,
Edhie Wibowo
"Vision Shows the Way, Passion Sustains the Journey"
:: XL-mania ::::::::::::::::::::
Momods sekarang jualan tas di www.flirtypoodle.com ha ha ha....
:: ------------- ::::::::::::::::::::
DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, pembicaraan pribadi, one line message, melecehkan, tidak sopan.
:: ------------- ::::::::::::::::::::
Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu"
Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu.
:: ------------- ::::::::::::::::::::
Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke
XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari
http://groups.yahoo.com/group/XL-mania/files/Promotion/
:: ------------- ::::::::::::::::::::
Berikan testimoni di :
http://www.xl-mania.com/2008/06/testimoni-xl-mania.html
:: ------------- ::::::::::::::::::::
Message lama ada di :
http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]
http://www.mail-archive.com/xl-mania@yahoogroups.com
Momods sekarang jualan tas di www.flirtypoodle.com ha ha ha....
:: ------------- ::::::::::::::::::::
DILARANG : MLM, money game, OOT, iklan tanpa izin, SARA, testing, pembicaraan pribadi, one line message, melecehkan, tidak sopan.
:: ------------- ::::::::::::::::::::
Buat subjek yang kreatif, jangan : "tanya", "help", "mohon bantu"
Usahakan besar attachment < 200 kb. Gunakan winzip jika perlu.
:: ------------- ::::::::::::::::::::
Ajak teman-teman Anda bergabung dengan mengirim e-mail kosong ke
XL-mania-subscribe@yahoogroups.com atau kirimkan mereka file dari
http://groups.yahoo.com/group/XL-mania/files/Promotion/
:: ------------- ::::::::::::::::::::
Berikan testimoni di :
http://www.xl-mania.com/2008/06/testimoni-xl-mania.html
:: ------------- ::::::::::::::::::::
Message lama ada di :
http://groups.yahoo.com/group/XL-mania/messages [perlu yahoo id]
http://www.mail-archive.com/xl-mania@yahoogroups.com
Tidak ada komentar:
Posting Komentar