' If we find decimal place...
If DecimalPlace > 0 Then
' Convert cents
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Centavos = ConvertTens(Temp)
' Strip off cents from remainder to convert.
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
' Convert last 3 digits of MyNumber to English dollars.
Temp = ConvertHundreds(Right(MyNumber, 3))
If Len(MyNumber) = 7 And Left(MyNumber, 1) = "1" Then
Place(3) = " Milhpo "
ElseIf Len(MyNumber) = 4 And Left(MyNumber, 1) = "1" Then
Place(4) = " Bilipo "
ElseIf Len(MyNumber) = 1 And Left(MyNumber, 1) = "1" Then
Place(5) = " Trilipo "
End If
If Temp <> "" Then Escudos = IIf(Temp = "Um" And Count = 2, "", Temp) & IIf(Count = 2 And Escudos <> "", RTrim(Place(Count)) & ", ", Place(Count)) & Escudos
If Len(MyNumber) > 3 Then
' Remove last 3 converted digits from MyNumber.
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
' Clean up dollars.
Select Case Escudos
Case ""
Escudos = " e Zero Escudos"
Case "Um"
Escudos = " e Um Escudo"
Case Else
If Right(Escudos, 3) = "po " Or Right(Escudos, 4) = ")es " Then
Escudos = Trim(Escudos) & " de Escudos"
Else
Escudos = Trim(Escudos) & " Escudos"
End If
Escudos = Replace(Escudos, "po ", "po, ")
Escudos = Replace(Escudos, ")es ", ")es, ")
If InStr(1, Escudos, ", de") <> 0 Then
Escudos = Replace(Escudos, ", de", " de")
End If
End Select
' Clean up cents.
Select Case Centavos
Case ""
Centavos = " e Zero Centavos"
Case "Um"
Centavos = " e Um Centavo"
Case Else
Centavos = " e " & RTrim(Centavos) & " Centavos"
End Select
ConvertCurrencyToportugues = Escudos & Centavos
End Function
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "Um"
Case 2: ConvertDigit = "Dois"
Case 3: ConvertDigit = "TrOs"
Case 4: ConvertDigit = "Quatro"
Case 5: ConvertDigit = "Cinco"
Case 6: ConvertDigit = "Seis"
Case 7: ConvertDigit = "Sete"
Case 8: ConvertDigit = "Oito"
Case 9: ConvertDigit = "Nove"
Case 10: ConvertDigit = " "
Case Else: ConvertDigit = ""
End Select
End Function
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
' Exit if there is nothing to convert.
If Val(MyNumber) = 0 Then Exit Function
' Append leading zeros to number.
MyNumber = Right("000" & MyNumber, 3)
' Do we have a hundreds place digit to convert?
Select Case Val(Left(MyNumber, 1))
Case 1
If Mid(MyNumber, 2, 2) <> "00" Then
Result = "Cento "
Else
Result = "Cem "
End If
Case 2: Result = "Duzentos "
Case 3: Result = "Trezentos "
Case 5: Result = "Quinhentos "
Case Else: Result = ConvertDigit(Left(MyNumber, 1)) & IIf(MyNumber > 99, "centos ", "")
End Select
' Do we have a tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & IIf(MyNumber > 99, "e ", "") & ConvertTens(Mid(MyNumber, 2))
Else
' If not, then convert the ones place digit.
Result = Result & IIf((Result = "Cem " Or Result = "" Or Mid(MyNumber, 3, 1) = "0"), "", "e ") & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
Private Function ConvertTens(ByVal MyTens)
Dim Result As String
' Is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
Case 10: Result = "Dez "
Case 11: Result = "Onze "
Case 12: Result = "Doze "
Case 13: Result = "Treze "
Case 14: Result = "Catorze "
Case 15: Result = "Quinze "
Case 16: Result = "Dezasseis "
Case 17: Result = "Dezassete "
Case 18: Result = "Dezoito "
Case 19: Result = "Dezanove "
Case Else
End Select
Else
' .. otherwise it's between 20 and 99.
Select Case Val(Left(MyTens, 1))
Case 2: Result = "Vinte "
Case 3: Result = "Trinta "
Case 4: Result = "Quarenta "
Case 5: Result = "Cinquenta "
Case 6: Result = "Sessenta "
Case 7: Result = "Setenta "
Case 8: Result = "Oitenta "
Case 9: Result = "Noventa "
Case Else
End Select
' Convert ones place digit.
Result = Result & IIf(Val(Right(MyTens, 1)) <> 0, "e ", "") & ConvertDigit(Right(MyTens, 1))
End If
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.