Jump to content


Photo

Valor Por Extenso No Access


  • This topic is locked This topic is locked
3 replies to this topic

#1 valri

valri
  • Membros
  • 4 posts

Posted 20 March 2006 - 19:31 PM

como faço para converter valores por extenso no access

#2 Graymalkin

Graymalkin

    www.gsxbr.net

  • Veteranos
  • 8228 posts
  • Gender:Male
  • Location:Duque de Caxias - RJ

Posted 20 March 2006 - 22:49 PM

Você quer transformar "1325" em "mil trezentos e vinte e cinco"? Se for o caso, não existe uma função pronta para isso (bom, deve existir no supra-sumo da sabedoria humana, naquele que tudo sabe e tudo pode... ou seja, no Google...). biggrin.gif

Abraços,

Graymalkin

#3 kuroi

kuroi
  • Membros
  • 7410 posts

Posted 21 March 2006 - 18:31 PM

tenho essa:

CODE
Function UF_Extenso(nValor As Double) As String
 If IsNull(nValor) Or nValor <= 0 Or nValor > 999999999999.99 Then
    Exit Function
 End If
 
 Dim Contador As Integer
 Dim Tamanho  As Integer
 Dim Valor    As String
 Dim Parte    As String
 Dim Final    As String
 Dim Grupo(5) As String
 Dim Texto(5) As String
 Dim Unidade(19)  As String
 Unidade(1) = "UM "
 Unidade(2) = "DOIS "
 Unidade(3) = "TRES "
 Unidade(4) = "QUATRO "
 Unidade(5) = "CINCO "
 Unidade(6) = "SEIS "
 Unidade(7) = "SETE "
 Unidade(8) = "OITO "
 Unidade(9) = "NOVE "
 Unidade(10) = "DEZ "
 Unidade(11) = "ONZE "
 Unidade(12) = "DOZE "
 Unidade(13) = "TREZE "
 Unidade(14) = "QUATORZE "
 Unidade(15) = "QUINZE "
 Unidade(16) = "DEZESSEIS "
 Unidade(17) = "DEZESSETE "
 Unidade(18) = "DEZOITO "
 Unidade(19) = "DEZENOVE "
 Dim Dezena(9) As String
 Dezena(1) = "DEZ "
 Dezena(2) = "VINTE "
 Dezena(3) = "TRINTA "
 Dezena(4) = "QUARENTA "
 Dezena(5) = "CINQUENTA "
 Dezena(6) = "SESSENTA "
 Dezena(7) = "SETENTA "
 Dezena(8) = "OITENTA "
 Dezena(9) = "NOVENTA "
 Dim Centena(9) As String
 Centena(1) = "CENTO "
 Centena(2) = "DUZENTOS "
 Centena(3) = "TREZENTOS "
 Centena(4) = "QUATROCENTOS "
 Centena(5) = "QUINHENTOS "
 Centena(6) = "SEISCENTOS "
 Centena(7) = "SETECENTOS "
 Centena(8) = "OITOCENTOS "
 Centena(9) = "NOVECENTOS "
 Valor = Format(nValor, "000000000000.00")
 Grupo(1) = Mid(Valor, 1, 3)
 Grupo(2) = Mid(Valor, 4, 3)
 Grupo(3) = Mid(Valor, 7, 3)
 Grupo(4) = Mid(Valor, 10, 3)
 Grupo(5) = "0" + Mid(Valor, 14, 2)
 
 For Contador = 1 To 5
     Parte = Grupo(Contador)
     Tamanho = Switch(Val(Parte) < 10, 1, Val(Parte) < 100, 2, Val(Parte) < 1000, 3)
     
     If Tamanho = 3 Then
        If Right(Parte, 2) <> "00" Then
           Texto(Contador) = Texto(Contador) & Centena(Left(Parte, 1)) + "E "
           Tamanho = 2
        Else
           Texto(Contador) = Texto(Contador) & IIf(Left(Parte, 1) = "1", "CEM ", Centena(Left(Parte, 1)))
        End If
     End If
   
     If Tamanho = 2 Then
        If Val(Right(Parte, 2)) < 20 Then
           Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 2))
        Else
           Texto(Contador) = Texto(Contador) & Dezena(Mid(Parte, 2, 1))
           If Right(Parte, 1) <> "0" Then
              Texto(Contador) = Texto(Contador) & "E "
              Tamanho = 1
           End If
        End If
     End If
     
     If Tamanho = 1 Then
        Texto(Contador) = Texto(Contador) & Unidade(Right(Parte, 1))
     End If
     
 Next Contador
 Final = ""
 
 If Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 0 And Val(Grupo(5)) > 0 Then
    Final = Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS")
 Else
    Final = Final & IIf(Val(Grupo(1)) > 0, Texto(1) & IIf(Val(Grupo(1)) > 1, "BILHÕES ", "BILHÃO "), "")
    Final = Final & IIf(Val(Grupo(2)) > 0, Texto(2) & IIf(Val(Grupo(2)) > 1, "MILHÕES ", "MILHÃO "), "")
    If Val(Grupo(2) + Grupo(3) + Grupo(4)) = 0 Then
       Final = Final & "DE "
    Else
       Final = Final & IIf(Val(Grupo(3)) > 0, Texto(3) & "MIL ", "")
    End If
    Final = Final & Texto(4) + IIf(Val(Grupo(1) + Grupo(2) + Grupo(3) + Grupo(4)) = 1, "REAL ", "REAIS ")
    Final = Final & IIf(Val(Grupo(5)) > 0, "E " & Texto(5) & IIf(Val(Grupo(5)) = 1, "CENTAVO", "CENTAVOS"), "")
 End If
 
 UF_Extenso = Final
 
End Function


#4 valri

valri
  • Membros
  • 4 posts

Posted 15 May 2006 - 16:42 PM

Valeu Graymalkin...

obrigado,

Valter




0 user(s) are reading this topic

0 members, 0 guests, 0 anonymous users