INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Access Howto:

convert numbers to portuguese word by JaSintoHenriqueSido
Posted: 2 Oct 00

Function ConvertCurrencyToportugues(ByVal MyNumber)
               
         Dim Temp
         Dim Escudos, Centavos
         Dim DecimalPlace, Count

         ReDim Place(9) As String
         Place(2) = " Mil "
         Place(3) = " Milh)es "
         Place(4) = " Bili)es "
         Place(5) = " Trili)es "

         ' Convert MyNumber to a string, trimming extra spaces.
         
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, ".")

         ' 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

         ConvertTens = Result
End Function



Back to Microsoft: Access Other topics FAQ Index
Back to Microsoft: Access Other topics Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close