Wednesday, July 24, 2013

Membuat Fungsi Terbilang Mengunakan VB

Disini saya akan memberikan source codenya siapa tau bermanfaat bagi anda :

Option Explicit

Private Function Konversi(ByVal nNilai As Currency) As String

Dim Grade As Variant
Dim strTerbilang As String
Dim strPart As String
Dim iGrade As Byte

Grade = Array("Triliun", "Milyar", "Juta", "Ribu", "")

strTerbilang = ""

If Len(CStr(nNilai)) > 15 Then
   
    strTerbilang = ""
   
Else
    If Trim(nNilai) = "0" Then Konversi = "Nol": Exit Function
       
        strPart = Format(nNilai, String(15, "0"))
       
        For iGrade = 1 To 5
            If Val(Mid(strPart, (iGrade - 1) * 3 + 1, 3)) > 0 Then
                strTerbilang = strTerbilang & GetRatus(Mid(strPart, (iGrade - 1) * 3 + 1, 3), iGrade)
            End If
        Next iGrade
   
    Konversi = strTerbilang
   
End If

End Function
Private Function GetRatus(ByVal strPart As String, ByVal iGrade As Byte) As String

Dim Angka1 As Variant, Angka2 As Variant
Dim i As Integer
Dim strHasil As String
Dim nTemp As Byte

Angka1 = Array("Satu ", "Dua ", "Tiga ", "Empat ", _
"Lima ", "Enam ", "Tujuh ", "Delapan ", "Sembilan ")
Angka2 = Array("Ratus ", "Puluh ", "")

For i = 1 To 3

nTemp = Val(Mid(strPart, i, 1))

If nTemp = 1 Then

If i = 1 Then

strHasil = "Seratus "

ElseIf i = 2 Then

i = i + 1

nTemp = Val(Mid(strPart, i, 1))

If nTemp = 0 Then

strHasil = strHasil & "Sepuluh "

ElseIf nTemp = 1 Then

strHasil = strHasil & "Sebelas "

Else

strHasil = strHasil & Angka1(nTemp - 1) & "Belas "
End If

ElseIf Val(strPart) = 1 And iGrade = 4 Then

strHasil = strHasil & "Se"

Else

strHasil = strHasil & "Satu "

End If

ElseIf nTemp <> 0 Then

strHasil = strHasil + Angka1(nTemp - 1) + Angka2(i - 1)

End If

Next i

GetRatus = strHasil

End Function


Private Sub Command1_Click()
 Me.Text2.Text = Konversi(Me.Text1.Text)
End Sub


Untuk Melihat Source yang sebenarnya bisa di download di sini

No comments: