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
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