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

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

Sunday, September 1, 2013

Ahlan wa sahlan

Semua informasi yang kulihat, ku dengar dan ku rasa, pastinya terekam dalam alam bawah sadarku,  tapi dengan bertambahnya umur pastinya daya ingatku akan semakin melemah, bahkan bisa juga menjadi lupa. Lantas aku berfikir, bagaimana kalau semua informasi yang ku dapat, musti harus ku tuangkan dalam sebuah cacatan kecil, dengan harapan ketika aku membuka catatan tersebut daya ingatku akan kembali lagi. Lebih-lebih catatan kecilku bisa bermanfaat untuk semua orang.

Akhirnya terciptakan sebuah blog ini, mudah-mudahan semua harapan ku bisa dikabulkan oleh Allah SWT.

SEMOGA BLOG INI BERMANFAAT UNTUK SEMUA, MENDAPAT RIDLO DARI ALLAH SWT. AMIIN....