July 03, 2011

Function Angka ke Huruf part 3

sebelumnya Kita mempelajari mengubah angka puluhan kali ini akan langsung dipaplikasikan untuk mengubah angka menjadi huruf dengan menambahkan string "rupiah" pada akhir konversi
misalnya = ubah3(123) menjadi seratus duapuluh tiga rupiah....
hem asik juga  ya macro...
dan untuk sintak nya tambahkan dari posting-posting sebelumnya



 Function ubah4(ByVal MyNumber)
    Dim Rupiah, Sen, Temp
    Dim Des, Desimal, Count, Tmp
    Dim IsNeg

    ReDim Place(9) As String
    Place(2) = "ribu "
    Place(3) = "juta "
    Place(4) = "milyar "
    Place(5) = "trilyun "

    'Ubah angka menjadi string
    MyNumber = Round(MyNumber, 2)
    MyNumber = Trim(Str(MyNumber))
    
    'Cek bilangan negatif
    If Mid(MyNumber, 1, 1) = "-" Then
        MyNumber = Right(MyNumber, Len(MyNumber) - 1)
        IsNeg = True
    End If

    'Posisi desimal, 0 jika bil. bulat
    Desimal = InStr(MyNumber, ".")
    'Pembulatan sen, dua angka di belakang koma
    Des = Mid(MyNumber, Desimal + 2)
    If Desimal > 0 Then
        Tmp = Left(Mid(MyNumber, Desimal + 1) & "00", 2)
        If Left(Tmp, 1) = "0" Then
            Tmp = Mid(Tmp, 2)
            Sen = ubah(Tmp)
        Else
            Sen = ubah2(Tmp)
        End If
        MyNumber = Trim(Left(MyNumber, Desimal - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
       Temp = ubah3(Right(MyNumber, 3), Count)
       If Temp <> "" Then Rupiah = Temp & Place(Count) & Rupiah
          If Len(MyNumber) > 3 Then
             MyNumber = Left(MyNumber, Len(MyNumber) - 3)
       Else
          MyNumber = ""
       End If
       Count = Count + 1
    Loop

    Select Case Rupiah
        Case ""
            Rupiah = "nol rupiah"
        Case Else
            Rupiah = Rupiah & "rupiah"
    End Select

    Select Case Sen
        Case ""
            Sen = ""
        Case Else
            Sen = " dan " & Sen & "sen"
    End Select

    If IsNeg = True Then
        ubah4 = "minus " & Rupiah & Sen
    Else
        ubah4 = Rupiah & Sen
    End If

End Function

Function ubah3(ByVal MyNumber, Count)
    Dim Result As String
    Dim Tmp

    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)

    'Mengubah seribu
    If MyNumber = "001" And Count = 2 Then
        ubah3 = "se"
        Exit Function
    End If

    'Mengubah ratusan
    If Mid(MyNumber, 1, 1) <> "0" Then
        If Mid(MyNumber, 1, 1) = "1" Then
            Result = "seratus "
        Else
            Result = ubah(Mid(MyNumber, 1, 1)) & "ratus "
        End If
    End If

    'Mengubah puluhan dan satuan
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & ubah2(Mid(MyNumber, 2))
    Else
        Result = Result & ubah(Mid(MyNumber, 3))
    End If

    ubah3 = Result

End Function

seperti pada postingan sebelumya tulis function ini di visual basic for application --> insert module
atau pada file excel anda...

silahkan di coba

No comments:

Post a Comment