Valor por extenso....

[Vilela 0]

Preciso de uma função para Access 2000 que transforma o valor em moeda para valor por extenso...Já procurei em tudo quanto foi lugar... mas só acho em ASP... tentei alterar o código mas não dá certo...Alguém pode me ajudar... POR FAVOR...?!?!?!?! :( :(

[Vilela 0]

:ph34r: :D :D DESCOBRI :D :D :D

 

Function VExtenso(NValor)On Error GoTo 99If IsNull(NValor) Or NValor > 9999999 ThenVExtenso = "# VALOR POR EXTENSO..............."Exit FunctionEnd IfIf (NValor) < 0 ThenNValor = NValor * -1End IfDim nContador, nTamanho As IntegerDim CValor, CPArte, CFinal, Etiq As StringReDim aGrupo(4), aTexto(4) As StringReDim aUnid(19) As StringaUnid(1) = "UM ": aUnid(2) = "DOIS ": aUnid(3) = "TRÊS "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 StringaDezena(1) = "DEZ ": aDezena(2) = "VINTE ": aDezena(3) = "TRINTA "aDezena(4) = "QUARENTA ": aDezena(5) = "CINQUENTA "aDezena(6) = "SESSENTA ": aDezena(7) = "SETENTA ": aDezena(8) = "OINTENTA "aDezena(9) = "NOVENTA "ReDim aCentena(9) As StringaCentena(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 4CPArte = aGrupo(nContador)nTamanho = Switch(Val(CPArte) < 10, 1, Val(CPArte) < 100, 2, Val(CPArte) _< 1000, 3)If nTamanho = 3 ThenIf Right$(CPArte, 2) <> "00" ThenaTexto(nContador) = aTexto(nContador) + aCentena(Left(CPArte, 1)) + _"E "nTamanho = 2ElseaTexto(nContador) = aTexto(nContador) + IIf(Left$(CPArte, 1) = "1", _"CEM ", aCentena(Left(CPArte, 1)))End IfEnd IfIf nTamanho = 2 ThenIf Val(Right(CPArte, 2)) < 20 ThenaTexto(nContador) = aTexto(nContador) + aUnid(Right(CPArte, 2))ElseaTexto(nContador) = aTexto(nContador) + aDezena(Mid(CPArte, 2, 1))If Right$(CPArte, 1) <> "0" ThenaTexto(nContador) = aTexto(nContador) + "E "nTamanho = 1End IfEnd IfEnd IfIf nTamanho = 1 ThenaTexto(nContador) = aTexto(nContador) + aUnid(Right(CPArte, 1))End IfNextIf Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 0 And Val(aGrupo(4)) <> 0 ThenCFinal = aTexto(4) + IIf(Val(aGrupo(4)) = 1, "CENTAVO", "CENTAVOS")ElseCFinal = ""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 ThenCFinal = CFinal + "de "ElseCFinal = CFinal + IIf(Val(aGrupo(2)) >= 1, aTexto(2) + "MIL ", "")End IfCFinal = 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 IfVExtenso = CFinalIf NValor > 2 And NValor < 2000 And Left(VExtenso, 2) = "UM" ThenVExtenso = Mid(VExtenso, 4, 250)ElseVExtenso = CFinalEnd IfExit Function99:VExtenso = "# ERRO DE VALOR"Exit FunctionEnd Function