Ir para conteúdo
Fórum Script Brasil
  • 0

Valor Por Extenso No Access


valri

Pergunta

3 respostass a esta questão

Posts Recomendados

  • 0

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

Link para o comentário
Compartilhar em outros sites

  • 0

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

Link para o comentário
Compartilhar em outros sites

Visitante
Este tópico está impedido de receber novos posts.


  • Estatísticas dos Fóruns

    • Tópicos
      152k
    • Posts
      651,7k
×
×
  • Criar Novo...