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