Selasa, 15 Desember 2009

Trik Merubah Angka Menjadi Bilangan (Ms-Excel)

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 !!

1 komentar: