|
|
Metode dan Algoritma | Excel Macro : Mengubah Uang jadi Terbilang Rupiah . Anda bisa melakukan konsultasi tentang Excel Macro : Mengubah Uang jadi Terbilang Rupiah melalui form di samping kanan !!!
Karena suatu permintaan, penulis membuat program di bawah ini,, yaitu kode program Macro VB di Microsoft Excel untuk mengubah angka uang menjadi kalimat terbilang rupiah, misal : 1234560 menjadi Satu Juta Dua Ratus Tiga Puluh Empat Ribu Lima Ratus Enam Puluh Rupiah.
Program ini sangat berguna ketika kita membuat kuitansi.
Private Sub CommandButton1_Click()
Range("A2").FormulaR1C1 = UCase(terbilang())
End Sub
Private Sub CommandButton2_Click()
Range("A2").FormulaR1C1 = LCase(terbilang())
End Sub
Private Sub CommandButton3_Click()
Range("A2").FormulaR1C1 = "=PROPER(""" & ubah(Range("A1").Value) & """)"
End Sub
Function terbilang()
'
' Terbilang Macro
' Macro recorded 20/06/2010 by erlin estiana
'
'
Range("A2").FormulaR1C1 = ubah(Range("A1").Value)
terbilang = ubah(Range("A1").Value)
End Function
Function satuan(inp)
If (inp = 1) Then
satuan = "satu "
ElseIf (inp = 2) Then
satuan = "dua "
ElseIf (inp = 3) Then
satuan = "tiga "
ElseIf (inp = 4) Then
satuan = "empat "
ElseIf (inp = 5) Then
satuan = "lima "
ElseIf (inp = 6) Then
satuan = "enam "
ElseIf (inp = 7) Then
satuan = "tujuh "
ElseIf (inp = 8) Then
satuan = "delapan "
ElseIf (inp = 9) Then
satuan = "sembilan "
Else
satuan = ""
End If
End Function
Function belasan(inp)
Dim proses
proses = inp
If (proses = "11") Then
belasan = "sebelas "
Else
proses = Mid(proses, 2, 1)
belasan = satuan(proses) & "belas "
End If
End Function
Function puluhan(inp)
Dim proses
proses = inp
If (proses = 1) Then
puluhan = "sepuluh "
ElseIf (proses = 0) Then
puluhan = ""
Else
puluhan = satuan(proses) & "puluh "
End If
End Function
Function ratusan(inp)
Dim proses
proses = inp
If (proses = 1) Then
ratusan = "seratus "
ElseIf (proses = 0) Then
ratusan = ""
Else
ratusan = satuan(proses) & "ratus "
End If
End Function
Function ribuan(inp)
Dim proses
proses = inp
If (proses = 1) Then
ribuan = "seribu "
ElseIf (proses = 0) Then
ribuan = ""
Else
ribuan = satuan(proses) & "ribu "
End If
End Function
Function jutaan(inp)
Dim proses
proses = inp
If (proses = 0) Then
jutaan = ""
Else
jutaan = satuan(proses) & "juta "
End If
End Function
Function milyaran(inp)
Dim proses
proses = inp
If (proses = 0) Then
milyaran = ""
Else
milyaran = satuan(proses) & "milyar "
End If
End Function
Function ubah(uang)
Dim kata
kata = ""
Dim rp
rp = Trim(uang)
Dim angka
Dim angka1
Dim tambahan
angka = ""
angka1 = ""
If (Len(rp) >= 10) Then
angka = Mid(rp, Len(rp) + 1 - 10, 1)
kata = kata & milyaran(angka)
End If
tambahan = ""
If (Len(rp) >= 9) Then
angka = Mid(rp, Len(rp) + 1 - 9, 1)
kata = kata & ratusan(angka)
If (angka > 0) Then tambahan = "juta "
End If
If (Len(rp) >= 8) Then
angka = Mid(rp, Len(rp) + 1 - 8, 1)
angka1 = Mid(rp, Len(rp) + 1 - 7, 1)
If ((angka = 1) And (angka1 > 0)) Then
angka = Mid(rp, Len(rp) + 1 - 8, 2)
kata = kata & belasan(angka) & "juta "
Else
angka = Mid(rp, Len(rp) + 1 - 8, 1)
kata = kata & puluhan(angka)
If (angka > 0) Then tambahan = "juta "
angka = Mid(rp, Len(rp) + 1 - 7, 1)
kata = kata & jutaan(angka)
If (angka = 0) Then kata = kata & tambahan
End If
End If
If (Len(rp) = 7) Then
angka = Mid(rp, Len(rp) + 1 - 7, 1)
kata = kata & jutaan(angka)
If (angka = 0) Then kata = kata & tambahan
End If
tambahan = ""
If (Len(rp) >= 6) Then
angka = Mid(rp, Len(rp) + 1 - 6, 1)
kata = kata & ratusan(angka)
If (angka > 0) Then tambahan = "ribu "
End If
If (Len(rp) >= 5) Then
angka = Mid(rp, Len(rp) + 1 - 5, 1)
angka1 = Mid(rp, Len(rp) + 1 - 4, 1)
If ((angka = 1) And (angka1 > 0)) Then
angka = Mid(rp, Len(rp) + 1 - 5, 2)
kata = kata & belasan(angka) & "ribu "
Else
angka = Mid(rp, Len(rp) + 1 - 5, 1)
kata = kata & puluhan(angka)
If (angka > 0) Then tambahan = "ribu "
angka = Mid(rp, Len(rp) + 1 - 4, 1)
kata = kata & ribuan(angka)
If (angka = 0) Then kata = kata & tambahan
End If
End If
If (Len(rp) = 4) Then
angka = Mid(rp, Len(rp) + 1 - 4, 1)
kata = kata & ribuan(angka)
If (angka = 0) Then kata = kata & tambahan
End If
If (Len(rp) >= 3) Then
angka = Mid(rp, Len(rp) + 1 - 3, 1)
kata = kata & ratusan(angka)
End If
If (Len(rp) >= 2) Then
angka = Mid(rp, Len(rp) + 1 - 2, 1)
angka1 = Mid(rp, Len(rp) + 1 - 1, 1)
If ((angka = 1) And (angka1 > 0)) Then
angka = Mid(rp, Len(rp) + 1 - 2, 2)
kata = kata & belasan(angka)
Else
kata = kata & puluhan(angka)
angka = Mid(rp, Len(rp) + 1 - 1, 1)
kata = kata & satuan(angka)
End If
End If
If (Len(rp) = 1) Then
angka = Mid(rp, Len(rp) + 1 - 1, 1)
kata = kata & satuan(angka)
End If
ubah = kata
End Function
File Excel nya dapat didownload di link berikut ini :
https://docs.google.com/open?id=0B4i1FYc_4RXzdTZ5eGNWZVd6ZWM
Semoga Berguna
ActionScript AS3 ASP.NET AJAX C / C++ C# Clipper COBOL ColdFusion DataFlex Delphi Emacs Lisp Fortran FoxPro Java J2ME JavaScript JScript Lingo MATLAB Perl PHP PostScript Python SQL VBScript Visual Basic 6.0 Visual Basic .NET Flash MySQL Oracle Android
Related Post :
Judul: Excel Macro : Mengubah Uang jadi Terbilang Rupiah
Rating: 100% based on 99998 ratings. 5 user reviews.
Ditulis Oleh hank2
Rating: 100% based on 99998 ratings. 5 user reviews.
Ditulis Oleh hank2
Anda sedang membaca artikel tentang
Excel Macro : Mengubah Uang jadi Terbilang Rupiah, Semoga artikel tentang Excel Macro : Mengubah Uang jadi Terbilang Rupiah ini sangat bermanfaat bagi teman-teman semua, jangan lupa untuk mengunjungi lagi melalui link
Excel Macro : Mengubah Uang jadi Terbilang Rupiah.
{ 0 komentar... Views All / Send Comment! }
Posting Komentar