Archive

Posts Tagged ‘Fungsi’
December 19th, 2009 DikMa 5 comments

Pertama-tama, fungsi ini bukan saya yang buat tapi saya dapatkan dari tetangga sebelah, dimana suatu ketika saya sangat lah membutuhkan fungsi ini untuk membuat suatu aplikasi/program yang ada dikantor saya.

Sebagai data backup kelak suatu hari nanti, namun demikian siapa tau para blogger ada yang memerlukannya juga, berikut step-step yang diperlukan  :

Option Compare Database
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"
   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
  • Simpan dengan Module = terbilang  dan tutup Jendela VBA tersebut.
  • Untuk Mengetes Apakah Fungsi tersebut berjalan dengan baik, buat Report Baru, dengan memasukan fungsi =ubah_terbilang()

25 Keyword pencarian terbanyak untuk artikel ini melalui mesin pencari Google :

File under :