Option Explicit
Public Count, Place 'au fost declarate publice, ca poata fi preluate de functia
PreiaUnitati
Function SpellNumber(ByVal MyNumber, Optional MyCurrency As String = "")
Dim Lei, bani, Temp
Dim DecimalPlace ', Count
ReDim Place(9) As String
Place(2) = " Mii "
Place(3) = " Milioane "
Place(4) = " Miliarde "
Place(5) = " Trilioane "
' Reprezentarea valorii in cuvinte.
MyNumber = Trim(Str(MyNumber))
' Pozitia zecimalei sau 0 daca nu exista.
DecimalPlace = InStr(MyNumber, ".")
' Converteste bani si seteaza MyNumber la valoare lei.
If DecimalPlace > 0 Then
bani = PreiaZeci(Left(Mid(MyNumber, DecimalPlace + 1) & 0, 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = PreiaSute(Right(MyNumber, 3))
If Temp <> "" Then Lei = Temp & Place(Count) & Lei
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Dim str_amount, str_amounts
Dim str_ban, str_bani
Select Case UCase(MyCurrency)
Case "EUR"
str_amount = "Euro"
str_amounts = "Euro"
str_ban = "cent"
str_bani = "centi"
Case "USD"
str_amount = "Dolar"
str_amounts = "Dolari"
str_ban = "Cent"
str_bani = "Centi"
Case Else:
str_amount = "Leu"
str_amounts = "Lei"
str_ban = "ban"
str_bani = "bani"
End Select
Select Case Lei
Case ""
Lei = "Zero " & str_amounts
Case "Unu"
Lei = "Un " & str_amount
Case Else
Lei = Lei & " " & str_amounts
End Select
Select Case bani
Case ""
bani = " si zero " & str_bani
Case "Unu"
bani = " si un " & str_ban
Case Else
bani = " si " & bani & " " & str_bani
End Select
SpellNumber = Lei & bani
End Function
' Converteste un numar din intervalul 100-999 in text
Function PreiaSute(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Aici sute.
If Mid(MyNumber, 1, 1) <> "0" Then
If Mid(MyNumber, 1, 1) = "1" Then
Result = " O Suta "
ElseIf Mid(MyNumber, 1, 1) = "2" Then
Result = " Doua Sute "
Else
Result = PreiaUnitati(Mid(MyNumber, 1, 1)) & " Sute "
End If
End If
' Converteste zeci si unitati.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & PreiaZeci(Mid(MyNumber, 2))
Else
Result = Result & PreiaUnitati(Mid(MyNumber, 3))
End If
PreiaSute = Result
End Function
' Converteste un numar din intervalul 10-99 in text.
Function PreiaZeci(ZeciText)
Dim Result As String
Result = "" ' Anuleaza valoarea functiei temporare.
If Val(Left(ZeciText, 1)) = 1 Then ' Daca valoarea este intre 10-19...
Select Case Val(ZeciText)
Case 10: Result = "Zece"
Case 11: Result = "Unsprezece"
Case 12: Result = "Doisprezece"
Case 13: Result = "Treisprezece"
Case 14: Result = "Paisprezece"
Case 15: Result = "Cincisprezece"
Case 16: Result = "Saisprezece"
Case 17: Result = "Saptesprezece"
Case 18: Result = "Optsprezece"
Case 19: Result = "Nouasprezece"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(ZeciText, 1))
Case 2:
If Right(ZeciText, 1) = "0" Then
Result = "Douazeci "
Else
Result = "Douazeci si "
End If
Case 3:
If Right(ZeciText, 1) = "0" Then
Result = "Treizeci "
Else
Result = "Treizeci si "
End If
Case 4:
If Right(ZeciText, 1) = "0" Then
Result = "Patruzeci "
Else
Result = "Patruzeci si "
End If
Case 5:
If Right(ZeciText, 1) = "0" Then
Result = "Cincizeci "
Else
Result = "Cincizeci si "
End If
Case 6:
If Right(ZeciText, 1) = "0" Then
Result = "Saizeci "
Else
Result = "Saizeci si "
End If
Case 7:
If Right(ZeciText, 1) = "0" Then
Result = "Saptezeci "
Else
Result = "Saptezeci si "
End If
Case 8:
If Right(ZeciText, 1) = "0" Then
Result = "Optzeci "
Else
Result = "Optzeci si "
End If
Case 9:
If Right(ZeciText, 1) = "0" Then
Result = "Nouazeci "
Else
Result = "Nouazeci si "
End If
Case Else
End Select
Result = Result & PreiaUnitati(Right(ZeciText, 1)) ' Recupereaza unitatile.
End If
If ZeciText > 20 Then
PreiaZeci = Result & " de"
Else
PreiaZeci = Result
End If
End Function
' Converteste un numar din intervalul 1-9 in text.
Function PreiaUnitati(Digit)
Select Case Val(Digit)
Case 1:
If Count = 1 Then
PreiaUnitati = "Unu"
ElseIf Count = 2 Then
PreiaUnitati = "O"
Place(2) = " Mie "
ElseIf Count = 3 Then
PreiaUnitati = "Un"
Place(3) = " Milion "
ElseIf Count = 4 Then
PreiaUnitati = "Un"
Place(4) = " Miliard "
ElseIf Count = 5 Then
PreiaUnitati = "Un"
Place(5) = " Trilion "
End If
Case 2:
If Count = 1 Then
PreiaUnitati = "Doi"
ElseIf Count = 2 Then
PreiaUnitati = "Doua"
ElseIf Count = 3 Then
PreiaUnitati = "Doua"
Place(3) = " Milioane "
ElseIf Count = 4 Then
PreiaUnitati = "Doua"
Place(4) = " Miliarde "
ElseIf Count = 5 Then
PreiaUnitati = "Doua"
Place(5) = " Trilioane "
End If
Case 3: PreiaUnitati = "Trei"
Case 4: PreiaUnitati = "Patru"
Case 5: PreiaUnitati = "Cinci"
Case 6: PreiaUnitati = "Sase"
Case 7: PreiaUnitati = "Sapte"
Case 8: PreiaUnitati = "Opt"
Case 9: PreiaUnitati = "Noua"
Case Else: PreiaUnitati = ""
End Select
End Function
