|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (Datas/Números/Strings)
|
|
 |
Título da Dica: Numeros Por Extenso
|
 |
|
|
|
Postada em 12/8/2004 por Barto
Function Extenso(nValor) As String
'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 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
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
Extenso = cFinal
End Function
|
|
|
|
|
