NUMERO POR EXTENSO

ARPRADO 25/08/2010 16:40:38
#351259
Tenho uma função que gera o número por extenso, só que quando informo o número 2010 deveria escrever da seguinte forma [Ô]dois mil e dez[Ô] e a função me dar [Ô]dois mil dez[Ô], faltando o [Ô]e[Ô], alguém pode me passar a correção desta função?

Public Function Extenso(nValor As String, nMoeda As Boolean) As String
If nValor = [Ô][Ô] Then Exit Function
nValor = Format(nValor, [Ô]0.00[Ô])
If IsNull(nValor) Or nValor <= 0 Or nValor > 9999999.99 Then
Extenso = [Ô][Ô]
Exit Function
End If

[ô]Declara as variáveis da função
Dim nContador, nTamanho As Integer
Dim cValor, cParte, cFinal As String
ReDim aGrupo(4), atexto(4) As String

[ô]Define matrizes com extensos parciais
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 [Ô]

[ô]Divide o valor em vários grupos
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
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
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
If nMoeda Then
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[Ô]), [Ô][Ô])
Else
cFinal = cFinal + atexto(3)
cFinal = cFinal + IIf(Val(aGrupo(4)) <> 0, [Ô]E [Ô] + atexto(4), [Ô][Ô])
End If
End If
Extenso = cFinal
End Function
VB6MASTER 25/08/2010 21:20:19
#351294 Resposta escolhida
Reveja essa parte do seu código: 
    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
          [txt-color=#e80000]atexto(nContador) = atexto(nContador) + [Ô]E [Ô][/txt-color]
          nTamanho = 1
        End If
      End If
    End If

Execute linha/linha [F8] e verifique se passa por esta linha e o que ocorre.
Tópico encerrado , respostas não são mais permitidas
Voltar