Function untuk merubah Angka menjadi Bilangan Rupiah pada MS-Excel
biasanya berguna buat bikin Pemrograman Nota Faktur sederhana.
Contoh , angka Rp.2500 akan tertulis "Dua ribu lima ratus rupiah"
Cara membuatnya sbb ;
1. File ini jangan ditutup dulu, langsung aja buka MS-Excelnya
2. Pada Sheet-1 tekan ALT+F11
3. Pada Visual Basic Klik menu Insert - Module
4. Klik task bar ,Balik lagi ke Notepad ini,
Langsung Copy rumus dibawah ini mulai dari "Option Explicit" (Yg dibawah ini) s/d End Function (Yg paling bawah)
Caranya letakkan pointer didepan huruf Option Explicit , Lalu Tekan Shift+PadeDown (panah bawah).
5. setelah rumusnya diblok, tekan Ctrl C
6. Balik lagi ke VB, langsung tekan Ctrl V , kemudian tekan ALT+Q untuk menutup VB Editor
Cara menggunakannya sbb ;
1. Pada Sheet-1 Cell A1 ketikkan angka 3456789
2. Pada Cell A2 ketik sepert ini =RPTEXT(A1) tekan enter
3. Selesai
Option Explicit
'****************
' Main Function *
'****************
Function RPTEXT(ByVal MyNumber)
Dim Rupiah, 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 rupiah 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 Rupiah = Temp & Place(Count) & Rupiah
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Rupiah
Case ""
Rupiah = ""
Case "One"
Rupiah = "Satu Rupiah"
Case Else
Rupiah = Rupiah & " Rupiah"
End Select
Select Case Cents
Case ""
Cents = " "
Case "One"
Cents = " "
Case Else
Cents = " " & Cents & " Sen"
End Select
RPTEXT = Rupiah & 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
Pertama kali saya dapet rumus ini juga, masih english version (Value to Dollars)
di-edit sedikit, jadi dah. " Value to Rupiah ", cm sy lupa ni link dapet darimana coz' sy salin dari buku lama sy.
Untuk selanjutnya kembangkan aja sendiri, pake bahasa Jawa, Sunda, Batak, Menado
Copas aja, mau dicantumin atau kagak asalnya, terserah dah. Selamat Mencoba !!