Tuesday, September 17, 2013

Kode "terbilang" pada Excel dengan macro

Suatu ketika aku dapat order untuk dibuatkan program pembayaran keuangan berbasis Microsoft Excel, yang mana untuk tampilan nota harus ada rumus "TERBILANG" sesuai dengan jumlah yang dibayarkan.
Awalnya memakai ad-ins, tapi ketika program tersebut di jalankan pada PC yang tidak ada ad-ins nya, rumus "TERBILANG" tidak bisa dijalankan.

Setelah googling kesana kemari akhirnya ketemu code vba nya (alhamdulillah)

Berikut langkah-langkahnya :
1. Masuk VBA ( Alt + F11 )
2. Buat Module, dan masukkan rumus dibawah ini, lalu SAVE.
3. Masuk ke microsoft excel
  
   rumus pada excelnya :

    =coretancomputer(kolomyangdituju)


 ==================================================

Public Function coretancomputer(x As Double) As String
Dim tampung As Double
Dim teks As String
Dim bagian As String
Dim i As Integer
Dim tanda As Boolean

Dim letak(5)
letak(1) = "Ribu "
letak(2) = "Juta "
letak(3) = "Milyar "
letak(4) = "Triliun "

If (x < 0) Then
    coretancomputer = ""
Exit Function
End If

If (x = 0) Then
    coretancomputer = "Nol"
Exit Function
End If

If (x < 2000) Then
    tanda = True
End If
teks = ""

If (x >= 1E+15) Then
    coretancomputer = "NILAI TERLALU BESAR"
Exit Function
End If

For i = 4 To 1 Step -1
    tampung = Int(x / (10 ^ (3 * i)))
    If (tampung > 0) Then
        bagian = ratusan(tampung, tanda)
        teks = teks & bagian & letak(i)
    End If
    x = x - tampung * (10 ^ (3 * i))
Next

teks = teks & ratusan(x, False)
coretancomputer = teks
End Function

Function ratusan(ByVal y As Double, ByVal flag As Boolean) As String
Dim tmp As Double
Dim bilang As String
Dim bag As String
Dim j As Integer

Dim angka(9)
angka(1) = "Se"
angka(2) = "Dua "
angka(3) = "Tiga "
angka(4) = "Empat "
angka(5) = "Lima "
angka(6) = "Enam "
angka(7) = "Tujuh "
angka(8) = "Delapan "
angka(9) = "Sembilan "

Dim posisi(2)
posisi(1) = "Puluh "
posisi(2) = "Ratus "

bilang = ""
For j = 2 To 1 Step -1
    tmp = Int(y / (10 ^ j))
    If (tmp > 0) Then
        bag = angka(tmp)
        If (j = 1 And tmp = 1) Then
            y = y - tmp * 10 ^ j
            If (y >= 1) Then
                posisi(j) = "Belas "
            Else
                angka(y) = "Se"
            End If
            bilang = bilang & angka(y) & posisi(j)
            ratusan = bilang
            Exit Function
        Else
            bilang = bilang & bag & posisi(j)
    End If
End If
y = y - tmp * 10 ^ j
Next

If (flag = False) Then
    angka(1) = "Satu "
End If
bilang = bilang & angka(y)
ratusan = bilang
End Function

==================================================

No comments:

Post a Comment