Cukup simple aja pengoperasiannya, rekan bapak maulana sdh berhasil menggunakan modul ini.. Copy paste saja modul itu dalam 1 modul dan akan membentuk 3 function yakni :
say3Digit
sayDigit
sayIDR
Kemudian simpan dengan nama file terbilang atau apalah terserah bapak
Eksekusi dengan sayIDR
Contoh : SayIDR([text32] )
Text32 adalah sumber data yg akan di convert
ini module nya :
Public Function terbilang(ByVal MyNumber, ByVal vmatauang)
Dim MataUang As String, cMataUang As String
Dim Rupiah, sen, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Dim a As Long
cMataUang = vmatauang
If cMataUang = "IDR" Then
MataUang = " rupiah"
ElseIf cMataUang = "USD" Then
MataUang = " dolar"
ElseIf cMataUang = "JPY" Then
MataUang = " yen"
ElseIf cMataUang = "SGD" Then
MataUang = " dolar singapura"
ElseIf cMataUang = "GBP" Then
MataUang = " poundsterling"
ElseIf cMataUang = "EUR" Then
MataUang = " euro"
Else
MataUang = " "
End If
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 sen and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
sen = 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 Rupiah = Temp & Place(Count) & Rupiah
If left(Trim(Rupiah) , 9) = "Satu Ribu" Then
Rupiah = " Seribu" & Mid(Rupiah, 11)
End If
If Len(MyNumber) > 3 Then
MyNumber = left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Rupiah
Case ""
Rupiah = "nol"
Case Else
Rupiah = Rupiah
End Select
Select Case sen
Case ""
sen = "" ' dan nol sen"
Case Else
sen = " koma" & sen
End Select
terbilang = Trim(Rupiah & sen & MataUang)
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
If Mid(MyNumber, 1, 1) = "1" Then
Result = " seratus"
Else
Result = GetDigit(Mid( MyNumber, 1, 1)) & " ratus"
End If
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
error disini :compile error:
expected variable or procedure, not module
Private Sub cbterbilang_ Click()
Me.Text84.Value = Terbilang(Me. indexAwal. Value, Me.MataUang. Value)
End Sub
sy coba buat db baru lalu copy modul dan buat text box lain, bisa tuh. aman2 saja.
to Mas End_Chuzt:
saya sudah coba modul mas tapi blom jalan, ada beberapa spt say3Digit = say3Digit sayDigit(Left$ (Right$(numStr, 2), 1)) "Puluh " apa salah ketik ya? sy coba2 blom bisa.
--apa mungkin error ini juga yg menyebabkan code autonumber (dlast)di db saya mengalami stack beberapa waktu lalu? posting minggu lalu(sayang tidak ada yg menjawab).
--terima kasih byk.
No comments:
Post a Comment