Tuesday, July 8, 2014

APLIKASI KWITANSI

Anda yang berkecimpung di bidang keuangan tidak lepas dari pembuatan Kwitansi, hal yang kadang terlihat sepele tetapi kadang berakibat fatal adalah ketika penulisan jumlah uang dalam angka dan huruf tidak sama atau kadang merasa jengke karena penulisan angka dan huruf secara manual menjadikan pekerjaan menjadi lama, jangan risau!
MACRONYA SBG BERIKUT:
 Public Function ProperCase(Teks As String)
    Dim i As Integer
    Dim temp As String
    Dim posisi As Integer
    Dim huruf As String * 1
      temp = ""
      For i = 1 To Len(Teks)
        huruf = Chr(Asc(Mid(Teks, i, 1)))
        If Len(Trim(huruf)) < 1 Then posisi = i + 1
        If i = posisi Or i = 1 Then
           temp = temp + UCase(Chr(Asc(Mid(Teks, i, 1))))
        Else
           temp = temp + LCase(Chr(Asc(Mid(Teks, i, 1))))
        End If
      Next i
      ProperCase = temp
End Function

Public Function Angkata(Nilai As Double) As String
    Dim Angka As Variant
 
    Angka = Array("", "satu", "dua", "tiga", "empat", "lima", "enam", _
    "tujuh", "delapan", "sembilan", "sepuluh", "sebelas")
 
    On Error GoTo Angkata_Error
 
        Select Case Nilai
            Case 0 To 11
                Angkata = " " & Angka(Nilai)
            Case 12 To 19
                Angkata = Angkata(Nilai - 10) & " belas"
            Case 20 To 99
                Angkata = Angkata(Nilai \ 10) & " puluh" & Angkata(Nilai Mod 10)
            Case 100 To 199
                Angkata = " seratus" & Angkata(Nilai Mod 100)
            Case 200 To 999
                Angkata = Angkata(Nilai \ 100) & " ratus" & Angkata(Nilai Mod 100)
            Case 1000 To 1999
                Angkata = " seribu" & Angkata(Nilai Mod 1000)
            Case 2000 To 999999
                Angkata = Angkata(Nilai \ 1000) & " ribu" & Angkata(Nilai Mod 1000)
            Case 1000000 To 999999999
                Angkata = Angkata(Nilai \ 1000000) & " juta" & Angkata(Nilai Mod 1000000)
            Case 1000000000 To 999999999999#
                Angkata = Angkata(Nilai \ 1000000000) & " milyar" & Angkata(Nilai Mod 1000000000)
            Case Else
                Angkata = Angkata(Nilai \ 1000000000000#) & " trilyun" & _
                Angkata(Nilai - (Nilai \ 1000000000000#) * 1000000000000#)

        End Select
        Exit Function
Angkata_Error:
    MsgBox Err.Description, vbCritical, "Error! Input tidak dapat diproses."
 
End Function

Public Function ArifBilangExcel(Bilangan As Double, Optional BentukPenulisan As Integer, _
Optional UnitMataUang As Boolean = True, Optional StylePecahan As Integer = 0) As String
    Dim temp As String
    Dim BilBulat As Double
    Dim Pecahan As String
    Dim SatBilBulat As String
    Dim SatPecahan As String
     
    BilBulat = Abs(Int(Bilangan))
    Pecahan = CStr(Right(FormatNumber(Bilangan, 2, , , vbFalse), 2))
    SatBilBulat = IIf(UnitMataUang = True, " rupiah", "")
    SatPecahan = IIf(UnitMataUang = True, " sen", "")
 
    temp = IIf(Bilangan < 0, "minus ", "") & Trim(Angkata(BilBulat)) & SatBilBulat
    temp = temp & IIf(Val(Pecahan) > 0, IIf(UnitMataUang = True, " dan ", " koma "), "")
    If UnitMataUang = True Then
        If StylePecahan = 1 Then
            temp = temp & IIf(Val(Pecahan) > 0, CStr(Val(Pecahan)) & "/100", "")
        Else
            temp = temp & IIf(Val(Pecahan) > 0, Trim(Angkata(Val(Pecahan))), "")
        End If
    Else
        If Val(Pecahan) > 0 Then
            temp = temp & IIf(Left(Pecahan, 1) = "0", "nol", Trim(Angkata(Val(Left(Pecahan, 1)))))
            temp = temp & IIf(Right(Pecahan, 1) = "0", "", " ")
            temp = temp & IIf(Right(Pecahan, 1) = "0", "", Trim(Angkata(Val(Right(Pecahan, 1)))))
        End If
    End If
    temp = temp & IIf(Val(Pecahan) > 0, SatPecahan, "")
 
    If BentukPenulisan = 1 Then
        ArifBilangExcel = UCase(temp)
    ElseIf BentukPenulisan = 2 Then
        ArifBilangExcel = LCase(temp)
    ElseIf BentukPenulisan = 3 Then
        ArifBilangExcel = ProperCase(temp)
    Else
        ArifBilangExcel = UCase(Mid(temp, 1, 1)) & Mid(temp, 2)
    End If

End Function




untuk keperluan anda membuat kuitansi.
petunjuk penggunaan

1. Anda terlebih dahulu bisa merubah nama file (me-rename) sesuka anda
2. Bukalah file tersebut dengan mengkliknya
3. Pastikan bahwa macro excel di-ENABLE terlebih dahulu
4. Buatlah form kwitansi sesuai yang anda ingikan
5. Jika penulisan jumlah uang degan angka di tulis pada sel D10 sedangkan penulisan dengan huruf di tulis pada D4, maka pada sel D4 anda tuliskan : =ArifBilangExcel(D10) maka akan terlihat hasil seperti conto di bawah ini

No comments:

Post a Comment