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