[Resolvido]Valor por extenso

Olá Pessoal,

Preciso que em um relatório do Access 2007 em uma caixa texto onde o valor de outra caixa de texto com valor numérico, volte a descrição do valor por extenso.

Agradeço desde já a ajuda.
Augusto Santana

Primeiro passo: crie um módulo e dê-lhe o nome de mdlExtenso ou outro nome que queira e cole a função abaixo:

Function Extenso95(nValor)
If IsNull(nValor) Or nValor <= 0 Or nValor > 9999999.99 Then
Exit Function
End If
Dim nContador, nTamanho As Integer
Dim cValor, cParte, cFinal As String
ReDim aGrupo(4), aTexto(4) As String
ReDim aUnid(19) As String
aUnid(1) = "UM ": aUnid(2) = "DOIS ": aUnid(3) = "TRES "
aUnid(4) = "QUATRO ": aUnid(5) = "CINCO ": aUnid(6) = "SEIS "
aUnid(7) = "SETE ": aUnid(8) = "OITO ": aUnid(9) = "NOVE "
aUnid(10) = "DEZ ": aUnid(11) = "ONZE ": aUnid(12) = "DOZE "
aUnid(13) = "TREZE ": aUnid(14) = "QUATORZE ": aUnid(15) = "QUINZE "
aUnid(16) = "DEZESSEIS ": aUnid(17) = "DEZESSETE ": aUnid(18) = "DEZOITO "
aUnid(19) = "DEZENOVE "
ReDim aDezena(9) As String
aDezena(1) = "DEZ ": aDezena(2) = "VINTE ": aDezena(3) = "TRINTA "
aDezena(4) = "QUARENTA ": aDezena(5) = "CINQUENTA "
aDezena(6) = "SESSENTA ": aDezena(7) = "SETENTA ": aDezena(8) = "OITENTA "
aDezena(9) = "NOVENTA "
ReDim aCentena(9) As String
aCentena(1) = "CENTO ": aCentena(2) = "DUZENTOS "
aCentena(3) = "TREZENTOS ": aCentena(4) = "QUATROCENTOS "
aCentena(5) = "QUINHENTOS ": aCentena(6) = "SEISCENTOS "
aCentena(7) = "SETECENTOS ": aCentena(8) = "OITOCENTOS "
aCentena(9) = "NOVECENTOS "
cValor = Format$(nValor, "0000000000.00")
aGrupo(1) = Mid$(cValor, 2, 3)
aGrupo(2) = Mid$(cValor, 5, 3)
aGrupo(3) = Mid$(cValor, 8, 3)
aGrupo(4) = "0" + Mid$(cValor, 12, 2)
For nContador = 1 To 4
cParte = aGrupo(nContador)
nTamanho = Switch(Val(cParte) < 10, 1, Val(cParte) < 100, 2, Val(cParte) < 1000, 3)
If nTamanho = 3 Then
If Right$(cParte, 2) <> "00" Then
aTexto(nContador) = aTexto(nContador) + aCentena(Left(cParte, 1)) + "E "
nTamanho = 2
Else
aTexto(nContador) = aTexto(nContador) + IIf(Left$(cParte, 1) = "1", "CEM ", aCentena(Left(cParte, 1)))
End If
End If
If nTamanho = 2 Then
If Val(Right(cParte, 2)) < 20 Then
aTexto(nContador) = aTexto(nContador) + aUnid(Right(cParte, 2))
Else
aTexto(nContador) = aTexto(nContador) + aDezena(Mid(cParte, 2, 1))
If Right$(cParte, 1) <> "0" Then
aTexto(nContador) = aTexto(nContador) + "E "
nTamanho = 1
End If
End If
End If
If nTamanho = 1 Then
aTexto(nContador) = aTexto(nContador) + aUnid(Right(cParte, 1))
End If
Next
If Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 0 And Val(aGrupo(4)) <> 0 Then
cFinal = aTexto(4) + IIf(Val(aGrupo(4)) = 1, "CENTAVO", "CENTAVOS")
Else
cFinal = ""
cFinal = cFinal + IIf(Val(aGrupo(1)) <> 0, aTexto(1) + IIf(Val(aGrupo(1)) > 1, IIf(aGrupo(2) Mod 100 = 0, "MILHÕES ", "MILHÕES, "), IIf(aGrupo(2) Mod 100 = 0, "MILHÃO E ", IIf(aGrupo(2) = 0 And aGrupo(3) = 0, "MILHÃO ", "MILHÃO, "))), "")
If Val(aGrupo(2) + aGrupo(3)) = 0 Then
cFinal = cFinal + "DE "
Else
If Val(aGrupo(3)) = 0 Then
cFinal = cFinal + IIf(Val(aGrupo(2)) <> 0, aTexto(2) + "MIL ", "")
Else
cFinal = cFinal + IIf(Val(aGrupo(3)) Mod 100 = 0 And aGrupo(4) = 0, IIf(Val(aGrupo(2)) <> 0, aTexto(2) + "MIL E ", ""), IIf(Val(aGrupo(2)) <> 0, aTexto(2) + "MIL, ", ""))
End If
End If
cFinal = cFinal + aTexto(3) + IIf(Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 1, "REAL ", "REAIS ")
cFinal = cFinal + IIf(Val(aGrupo(4)) <> 0, "E " + aTexto(4) + IIf(Val(aGrupo(4)) = 1, "CENTAVO", "CENTAVOS"), "")
End If
Extenso95 = cFinal
End Function

Segundo passo: coloque, dentro da caixa de texto que vai receber o extenso, nesse caso txtExtenso, o código =Extenso95([txtValor]).
nesse exemplo, o campo aonde será digitado o valor se chama txtValor e o campo que receberá o valor por extenso se chama txtExtenso. Nomeie seus campos conforme esses do exemplo ou mude o nome dos campos do exemplo para os que você tem no relatório e pronto.
Espero que resolva.

tenho outra função aqui:

Function Extenso(nValor As String) As String
'Autoria..: Eng. Cesar Costa e Dalicio Guiguer Filho
'Linguagem: Access Basic
'Data.....: Fevereiro/1994

'Modificada: Wintceas Villaça Godois Jr.
'Linguagem.: VBA
'Data......: Outubro/1997

'Modificada: César Rocha
'Linguagem.: VBA
'Data......: Novembro/1997

'Faz a validação do argumento
If IsNull(nValor) Or nValor > 999999999.99 Then Exit Function

'Declara as variáveis da função
Dim intContador As Integer
Dim intTamanho As Integer
Dim strValor As String
Dim strParte As String
Dim strFinal As String
Dim strGrupo(4) As String
Dim strTexto(4) As String

'Define matrizes com extensos parciais
Dim strUnid(19) As String
strUnid(1) = "um ": strUnid(2) = "dois ": strUnid(3) = "três ": strUnid(4) = "quatro ": strUnid(5) = "cinco ": strUnid(6) = "seis ": strUnid(7) = "sete ": strUnid(8) = "oito ": strUnid(9) = "nove ": strUnid(10) = "dez ": strUnid(11) = "onze ": strUnid(12) = "doze ": strUnid(13) = "treze ": strUnid(14) = "quatorze ": strUnid(15) = "quinze ": strUnid(16) = "dezesseis ": strUnid(17) = "dezessete ": strUnid(18) = "dezoito ": strUnid(19) = "dezenove "
Dim strDezena(9) As String
strDezena(1) = "dez ": strDezena(2) = "vinte ": strDezena(3) = "trinta ": strDezena(4) = "quarenta ": strDezena(5) = "cinqüenta ": strDezena(6) = "sessenta ": strDezena(7) = "setenta ": strDezena(8) = "oitenta ": strDezena(9) = "noventa "
Dim strCentena(9) As String
strCentena(1) = "cento ": strCentena(2) = "duzentos ": strCentena(3) = "trezentos ": strCentena(4) = "quatrocentos ": strCentena(5) = "quinhentos ": strCentena(6) = "seiscentos ": strCentena(7) = "setecentos ": strCentena(8) = "oitocentos ": strCentena(9) = "novecentos "

'Divide o valor em vários grupos
strValor = Format$(nValor, "0000000000.00")
strGrupo(1) = Mid$(strValor, 2, 3) 'Milhão
strGrupo(2) = Mid$(strValor, 5, 3) 'Milhar
strGrupo(3) = Mid$(strValor, 8, 3) 'Centena
strGrupo(4) = "0" + Mid$(strValor, 12, 2) 'Centavo

'Processa cada grupo
For intContador = 1 To 4
strParte = strGrupo(intContador)

intTamanho = Switch(Val(strParte) < 10, 1, Val(strParte) < 100, 2, Val(strParte) < 1000, 3)
If intTamanho = 3 Then
If Right$(strParte, 2) <> "00" Then
strTexto(intContador) = strTexto(intContador) + strCentena(Left(strParte, 1)) + "e "
intTamanho = 2
Else
strTexto(intContador) = strTexto(intContador) + IIf(Left$(strParte, 1) = "1", "cem ", strCentena(Left(strParte, 1)))
End If
End If

If intTamanho = 2 Then
If Val(Right(strParte, 2)) < 20 Then
strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 2))
Else
strTexto(intContador) = strTexto(intContador) + strDezena(Mid(strParte, 2, 1))
If Right$(strParte, 1) <> "0" Then
strTexto(intContador) = strTexto(intContador) + "e "
intTamanho = 1
End If
End If
End If

If intTamanho = 1 Then
strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
End If
Next intContador

'Gera o formato final do texto
If Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos")
Else
strFinal = ""
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
End If
If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
End If
If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
End If
If Val(strGrupo(3)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil ", "")
Else
If Val(strGrupo(4)) = 0 Then
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil e ", "")
Else
strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil, ", "")
End If
End If
If Val(strGrupo(4)) = 0 Then
strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais ")
Else
strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(3)) <> 1, IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais "), "real ")
End If
strFinal = strFinal + IIf(Val(strGrupo(4)) <> 0, "e " + strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos"), "")
End If
If Left(strFinal, 1) = "u" Then
Extenso = "H" & Mid$(strFinal, 1)
Else
Extenso = UCase(Mid$(strFinal, 1, 1)) & Mid$(strFinal, 2)
End If
Dim aux As String * 150
aux = Trim(Extenso) ' e alterar esta linha para trim(Extenso)
While Len(Trim(aux)) <> 150
aux = Trim(aux) & "-x"
Wend
Extenso = aux

End Function

Preazado Criquio,

Fiz exatamente como vc me instruiu, mas ao clicar no relatório, ele pede algumas informações pré estabelecidas na consulta para exibir o relatório, a expressão "Extenso95" aparece como mais um parâmetro de informação a ser inserida antes de aparecer o relatório. E ao clicar e não informar nada nesse novo parâmetro, o relatório é exibido e no campo onde deveria vir o valor por extenso, aparesse "#Erro".

Tente o seguinte:

Tire o código Me.txtExtenso = Extenso95([tTotal]) e coloque-o no evento No atual do relatório.

Nos meus testes aqui funcionou sossegado.

Criquio,

O evento "No Atual", só tem em um formulário, eu estou querendo usar em um relatório.

Abraços!!

Amigo Augusto, no Access 2007 tem o evento No atual para relatório, pois eu o testei no meu relatório aqui e funcinou direitinho. Não me lembro se nas versões anteriores tem esse evento em relatórios. Caso não tenha, você pode tentar os outros eventos que tenha, como por exemplo "Ao receber foco". Mas você está usando o 2007 tambem, não?

A minha versão é 2007.
Valeu!! Vou tentar.
Abraços e Obrigado!!
Se funcionar eu te aviso.

Amigos quando devolve esse #Erro é porque existe campo Nulo, se existem campos Nulos têm de utilizar a função Nz

Me.txtExtenso = Extenso95(Nz([tTotal]),0)

Criquio,

Gostaria de te agradecer pelas dicas, mas em nenhuma delas, consegui que voltasse o texto com o extenso. Nessa sua última dica o erro desapareceu, mas, o campo é exibido em branco.

Mesmo assim Obrigado!!!

Ricardo,

O "#erro" aparecia da primeira forma, ou seja, quando colocava na propriedade "fonte de controle" a função "=Extenso95([TxValor]).

Mesmo assim agradeço a ajuda de vcs dois.

Um grande Abraço!!!

Você abre esse relatório com duplo clique direto nele ou por um botão de formulário? O meu teste aqui foi com um relatório desvinculado que abro em um botão de um form e os dados do relatório são baseados nos campos do formulário.
Ainda não usei essa função do modo que parece que você precisa, mas se você abre o relatório pelo form, pode tentar desvincular os campos do relatório e colocar a fonte de cada campo como os campos do formulário, se todos os campos do relatório constarem tambem do formulário.

No rodapé do relatório em um campo não acoplado, na fonte do controle do campo coloque o seguinte =Extenso([Valor_Total])
E cole o código que falei em um modulo e salve.

Valeu topbr,

Vou tentar amanhã e se der certo eu te falo. Muito obrigado!!

Um grande Abraço!!

Do Professor Osmar;

http://dl.dropbox.com/u/771097/NumerosporExtenso.rar

Pessoal
sou totalmente leigo nisso

tentei essas dicas todas mas não consegui

será que alguem pode me ajudar?

Poste o banco e indique o relatório que deseja o extenso.

Pessoal,

Não tem ter a DLL Extenso para resolver este assunto ?

Abraços!

Não necessita de dll não!!!

PessoALL,

Bom, tenho um sistema aqui que funciona perfeitamente o "poe extenso".

Na pasta onde fica o sistema coloquei a DLL "EXTENS32.DLL" (em anexo) como oculta ou pode jogá-la tbm para dentro de "system32".

Criei um módulo chamado "ValorExtenso" e coloquei o código:

Option Compare Database

'============================================================

' A declaração abaixo deve ocupar uma única linha
Declare Function extenso Lib "Extens32.dll" (ByVal Valor As String, ByVal Retorno As String) As Integer

Function PassaExtenso(Valor As String) As String
' Passa um número para a DLL e
' recebe-o de volta por extenso

On Error GoTo Passa_Err

Dim Retorno$, x%
Retorno$ = Space$(512)
x% = extenso(Valor, Retorno$)
PassaExtenso = Trim$(Retorno$)

Passa_Fim:
Exit Function
Passa_Err:
MsgBox Error$(Err)
Resume Passa_Fim
End Function
'============================================================

Depois lá no relatório tempo o campo onde exibe o valor, por exemplo, "Total_Pedido".
Criei um campo e chamei a função: =PassaExtenso([Total_Pedido]).

Espero ajudá-los.

Um abraço.

Highlander, o que acontece é que pelo seu método, os cálculos ficam à cargo das constantes da dll, já nos outros métodos apresentados no tópico, os cálculos são feitos no próprio módulo. A desvantagem do segundo é a quantidade de linhas necessárias, enquanto que a desvantagem do primeiro é a necessidade de se ter a dll presente na máquina.

link pra baixar o extenso quebrado. pode atualizar: