Entre para seguir isso  
Seguidores 0

Valor Por Extenso No Access

4 posts neste tópico

Postado

como faço para converter valores por extenso no access

Compartilhar este post


Link para o post
Compartilhar em outros sites

Postado

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

Postado

tenho essa:

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

Compartilhar este post


Link para o post
Compartilhar em outros sites

Postado

Valeu Graymalkin...

obrigado,

Valter

Compartilhar este post


Link para o post
Compartilhar em outros sites
Este tópico está impedido de receber novos posts.
Entre para seguir isso  
Seguidores 0