salam kenal, 
saya : Syafril Sani 
anggota baru

saya punya syntax buat konversi angka ke huruf (terbilang) 
sebagaimana terlampir
saya mencoba untuk disederhanakan sehingga hasilnya menjadi : 
80.05 terbilang delapan nol koma nol lima bukan delapan puluh koma lima 
90.50 terbilang sembilan nol koma nol bukan sembilan puluh koma lima puluh
mohona pencerahannya dari teman-teman sekalian.
thank's
-----------------------------------------------------------------------------------------------------------
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 - (Nilai \ 1000000) * 1000000)
            Case Else
                Angkata = Angkata(Nilai \ 1000000000) & " milyar" & _
                Angkata(Nilai - (Nilai \ 1000000000) * 1000000000)
        End Select
        Exit Function
Angkata_Error:
    MsgBox Err.Description, vbCritical, "Error! Input tidak dapat diproses."
   
End Function
 
Public Function Terbilang(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
        Terbilang = UCase(temp)
    ElseIf BentukPenulisan = 2 Then
        Terbilang = LCase(temp)
    ElseIf BentukPenulisan = 3 Then
        Terbilang = ProperCase(temp)
    Else
        Terbilang = UCase(Mid(temp, 1, 1)) & Mid(temp, 2)
    End If
 
End Function


      

Attachment: SEDERHANA SAJA.rar
Description: Binary data

Kirim email ke