Blog | Beli Rumah | Belajar HTML dan PHP | Kontak | Gmail | Uang Adsense
Audit Sistem Informasi
Sistem Informasi (S1)
Manajemen Informatika
Komputer dan Pendidikan
Pengobatan Ruqyah
Daftar Isi | Skripsi SI | B. Arab | Sertifikat Komputer Internasional | PrivacyPolicy | Inggris Arab

Sunday, May 4, 2014

Cara Membuat Kwitansi Dengan Macro Microsoft Excel 2010


1.      Buka Microsoft Excel 2010
2.      Simpan dengan Save as type: Excel Macro-Enabled Workbook
3.      Nama file name bebas, misal: Kwitansi Macro
4.      Buatlah desain seperti ini:


5.      Klik tab Developer
6.      Klik Visual Basic



7.      Klik Insert – Module


8.      Akan muncul gambar seperti ini:


9.      Ketik script berikut ini:
Public Function sejumlah(x As Currency)
Dim triliun As Currency
Dim milyar As Currency
Dim juta As Currency

Dim ribu As Currency
Dim satu As Currency

Dim sen As Currency
Dim baca As String

If x > 1000000000000# Then
    sejumlah = "<di atas satu triliun rupiah>"
    Exit Function
End If
    If x = 0 Then
    baca = angka(0, 1)
Else
triliun = Int(x * 0.001 ^ 4)
milyar = Int((x - triliun * 1000 ^ 4) * 0.001 ^ 3)
juta = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3) / 1000 ^ 2)
ribu = Int((x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2) / 1000)
satu = Int(x - triliun * 1000 ^ 4 - milyar * 1000 ^ 3 - juta * 1000 ^ 2 - ribu * 1000)
sen = Int((x - Int(x)) * 100)

If triliun > 0 Then
    baca = ratus(triliun, 5) + " triliun"
End If


If milyar > 0 Then
    baca = ratus(milyar, 4) + " milyar"
End If


If juta > 0 Then
    baca = baca + ratus(juta, 3) + " juta"
End If


If ribu > 0 Then
    baca = baca + ratus(ribu, 2) + " ribu"
End If


If satu > 0 Then
    baca = baca + ratus(satu, 1) + " rupiah"
Else
    baca = baca + " rupiah"
End If



If sen > 0 Then
    baca = baca + ratus(sen, 0) + " sen"
End If
End If


sejumlah = UCase(Left(baca, 1)) & LCase(Mid(baca, 2))
End Function



Function ratus(x As Currency, posisi As Integer) As String
    Dim a100 As Integer, a10 As Integer, a1 As Integer
    Dim baca As String
    a100 = Int(x * 0.01)
    a10 = Int((x - a100 * 100) * 0.1)
    a1 = Int(x - a100 * 100 - a10 * 10)

   
    If a100 = 1 Then
        baca = "seratus"
    Else
        If a100 > 0 Then
            baca = angka(a100, posisi) + "ratus"
        End If
    End If


    If a10 = 1 Then
        baca = baca + angka(a10 * 10 + a1, posisi)
    Else


    If a10 > 0 Then
        baca = baca + angka(a10, posisi) + "puluh"
    End If

    If a1 > 0 Then
        baca = baca + angka(a1, posisi)
    End If
    End If
    ratus = baca
End Function



Function angka(x As Integer, posisi As Integer)
    Select Case x
        Case 0: angka = "Nol"
        Case 1:
            If posisi <= 1 Or posisi > 2 Then
                angka = "Satu"
            Else
                angka = "Se"
            End If
        Case 2: angka = "Dua"
        Case 3: angka = "Tiga"
        Case 4: angka = "Empat"
        Case 5: angka = "Lima"
        Case 6: angka = "Enam"
        Case 7: angka = "Tujuh"
        Case 8: angka = "Delapan"
        Case 9: angka = "Sembilan"
        Case 10: angka = "Sepuluh"
        Case 11: angka = "Sebelas"
        Case 12: angka = "Duabelas"
        Case 13: angka = "Tigabelas"
        Case 14: angka = "Empatbelas"
        Case 15: angka = "Limabelas"
        Case 16: angka = "Enambelas"
        Case 17: angka = "Tujuhbelas"
        Case 18: angka = "Delapanbelas"
        Case 19: angka = "Sembilanbelas"
    End Select
End Function


10.  Buka Sheet1 yang sudah ada desain kwitansinya
11.  Klik D4 (uang sejumlah)
12.  Ketik =sejumlah(
13.  Klik D7
14.  Enter
15.  Di kotak D4 akan muncul tulisan “Nol”
16.  Klik D7
17.  Ketik angka rupiah yang diinginkan, misal 200000
18.  Di cell D4 akan muncul tulisan “Duaratus ribu rupiah” seperti pada gambar berikut:




Sumber:
Majalah Infokomputer dalam Dedi Royadi. 2009. Langkah Mudah Microsoft Excel 2007. Jakarta: Lentera Ilmu Cendekia.
"Investasi Emas dan Reksadana, Untung Mana?."
Youtube: Katabah Com: Menuju 1 jt Konten :)

No comments:

Post a Comment