Script Kode Terbilang Rupiah Menggunakan VBA Access

msaccesseveryday.blogspot.co.id -  Berikut ini saya akan posting kode script VBA untuk terbilang Rupiah, lengkap dengan dengan desimalnya

Kode Programnya

Public Function ubah_terbilang(xbil As Double)
   Dim nilai, i, j, k, hasil$, HasilAkhir$, Bilangan#, Digit, Rp$, Bil$

   If IsNull(xbil) Then
      ubah_terbilang = Null
      Exit Function
   End If

'pengelompokan
    Dim Kel$(1 To 6), Angka$(1 To 9), Sat$(1 To 3)
    Kel$(1) = "Biliun "
    Kel$(2) = "Triliun "
    Kel$(3) = "Miliar "
    Kel$(4) = "Juta "
    Kel$(5) = "Ribu "
    Kel$(6) = ""

'data angka
    Angka$(1) = "Satu "
    Angka$(2) = "Dua "
    Angka$(3) = "Tiga "
    Angka$(4) = "Empat "
    Angka$(5) = "Lima "
    Angka$(6) = "Enam "
    Angka$(7) = "Tujuh "
    Angka$(8) = "Delapan "
    Angka$(9) = "Sembilan "

'satuan
    Sat$(1) = "Ratus "
    Sat$(2) = "Puluh "
    Sat$(3) = ""

'mulai
   Bilangan# = Val(xbil)
   HasilAkhir$ = ""
   GoSub HitungHuruf
   If hasil$ <> "" Then
    'HasilAkhir$ = hasil$ + "Rupiah"
    HasilAkhir$ = hasil$ + ""
   End If

'hitung pecahan
   Bilangan# = Fix((Bilangan# - Fix(Bilangan#) + 0.005) * 100#)
   If Bilangan# > 0 Then
      GoSub HitungHuruf
      If hasil$ <> "" Then
        HasilAkhir$ = HasilAkhir$ + " " + hasil$ + "Sen"
      End If
   End If

ubah_terbilang = HasilAkhir$

Exit Function

HitungHuruf:
    Rp$ = Right$(String$(18, "0") + LTrim$(Str$(Fix(Bilangan#))), 18)
    hasil$ = ""

    If Val(Rp$) = 0 Then Return

'blg bulat
   For i = 1 To 6
      Bil$ = Mid$(Rp$, i * 3 - 2, 3)

      If Val(Bil$) = 1 And i = 5 Then
         hasil$ = hasil$ + "Seribu "

      ElseIf Val(Bil$) <> 0 Then
         For j = 1 To 3
            Digit = Val(Mid$(Bil$, j, 1))
            If j = 2 And Right$(Bil$, 2) = "10" Then
               hasil$ = hasil$ + "Sepuluh "
               Exit For

            ElseIf j = 2 And Right$(Bil$, 2) = "11" Then
               hasil$ = hasil$ + "Sebelas "
               Exit For

            ElseIf j = 2 And Mid$(Bil$, 2, 1) = "1" Then
               hasil$ = hasil$ + Angka$(Val(Right$(Bil$, 1))) + "Belas "
               Exit For

            ElseIf Digit = 1 And j = 1 Then
               hasil$ = hasil$ + "Seratus "

            ElseIf Digit <> 0 Then
               hasil$ = hasil$ + Angka$(Digit) + Sat$(j)

            End If
         Next
         hasil$ = hasil$ + Kel$(i)
      End If
   Next
   Return
End Function.

Test Script Terbilang:

 

1. Pilih Create
2. Pilih Macro
3. Pilih Module

Copy script diatas Paste seperti gambar dibawah ini:

1. Paste diposisi ini
2. Ketik seperti ini: ?ubah_terbilang(1000000.10), dan terlihat hasilnya spt gambar diatas.

Sekian Dulu, Semoga bermanfaat

Tweet

Subscribe to receive free email updates: