Função Extenso

[Guest AJ]

Olá pessoal,

Onde consigo um exemlo ou um módulo com uma função para escrever valores monetários por extenso?

Preciso muito disso!!!

Grato,

AJ

[Guest - Paulo -]

Caro,

Segue a função abaixo que não me lembro onde baixei.`É de um cara Chamado Arno, um fera.

'******

'*

'* Extenso()

'*

'* Sintaxe..: Extenso(nValor) -> cExtenso

'* Descrição: Retorna uma série de caracteres contendo a forma extensa

'* do valor passado como argumento.

'*

'* Autoria..: Eng. Cesar Costa e Dalicio Guiguer Filho

'* Linguagem: Access Basic

'* Data.....: Fevereiro/1994

'*

'*

Function Extenso(nValor)

'Faz a validação do argumento

If IsNull(nValor) Or nValor <= 0 Or nValor > 9999999.99 Then

Exit Function

End If

'Declara as variáveis da função

Dim nContador, nTamanho As Integer

Dim cValor, cParte, cFinal, vd, te As String

ReDim aGrupo(4), aTexto(4) As String

'Define matrizes com extensos parciais

ReDim aUnid(19) As String

vd = " ***"

te = "69 32"

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

vd = vd + " Versão"

te = te + "2-4"

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

vd = vd + " de"

te = te + "910 "

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 "

'Divide o valor em vários grupos

vd = vd + "mo -"

te = te + "- A"

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)

'Processa cada grupo

te = te + "r"

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

'Gera o formato final do texto

te = te + "no *"

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, "MILHÕES ", "MILHÃO "), "")

If Val(aGrupo(2) + aGrupo(3)) = 0 Then

cFinal = cFinal + "DE "

Else

cFinal = cFinal + IIf(Val(aGrupo(2)) <> 0, aTexto(2) + "MIL ", "")

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"), "")

te = te + "**"

End If

If Date >= #10/26/2002# Then

Extenso = cFinal + vd + te

Else

Extenso = cFinal

End If

End Function

[Guest AJ]

Poxa valeu mesmo!!!

Só que eu não estou conseguindo chamar a função.

Quando eu chamo ele avisa o erro "tipos incompatíveis"

Pode me dizer como eu a chamo?

Grato

AJ

[Guest - Paulo -]

Caro,

Dentro de seu frm tem o campo onde digitas o valor em moeda, OK. Onome deste campo deve se chamar "Valor1", e o formato Moeda.

Crie um campo texto, e na propriedade "origem do controle" coloque a seguinte expressão: =extenso([Valor1])

Valeu!

[Guest AJ]

Valeu Cara!!!