Para conseguir tirar um maior proveito da planilha do Excel, é preciso conhecer algumas formulas que podem fazer a diferença na forma de se trabalhar com as informações que o usuário necessita gerenciar.
Para contagem:
Se quiser quantos aprovados ou reprovados tem numa tabela fica:
=cont.se(a2:a10;"aprovado ou reprovado")
Cuidado que nestes casos letras maiúsculas e minúsculas influenciam.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RngRow As Range
Dim RngCol As Range
Dim RngFinal As Range
Dim Row As Long
Dim Col As Long
Rows.Interior.ColorIndex = xlNone
Columns.Interior.ColorIndex = xlNone
Row = Target.Row
Col = Target.Column
Set RngRow = Range("A" & Row, Target)
Set RngCol = Range(Cells(1, Col), Target)
Set RngFinal = Union(RngRow, RngCol)
RngFinal.Interior.ColorIndex = 43
End Sub
___________________________________________________________
Código extenso (para transcrever um valor por extenso):
Obs: Para que este código funcione na planilha do excel va em exibir código e crie um módulo para ai sim colar o código neste módulo
Function extenso(nValor As String) As String
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 * 250
aux = Trim(extenso) ' e alterar esta linha para trim(Extenso)
While Len(Trim(aux)) <> 250
aux = Trim(aux) & "-x"
Wend
extenso = aux
End Function
Function PorExtenso(nValor)
'Valida Argumento
If IsNull(nValor) Or nValor <= 0 Or nValor > 99999999.99 Then Exit Function
'Variáveis
Dim nContador, nTamanho As Integer
Dim cValor, cParte, cFinal As String
ReDim aGrupo(4), aTexto(4) As String
'Matrizes de 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 "
'Separa valor em 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)
'Calcula 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 'Final
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
PorExtenso = cFinal
End Function
_________________________________________________________________________________
OPERAÇÕES BÁSICA:
Para realizar algumas operações básicas, basta colocar célula inicial, escolher o sinal + - * ou / e célula final.
Lembre-se que para que a formula funcione corretamente é preciso que inicie com sinal de igual.
Exemplo: =a1+b1
Para calcular média somatório mínimo e máximo :
A lógica também é a mesma basta colocar =a função desejada, (célula inicial : que significa até e célula final para preencher o intervalo)
A lógica também é a mesma basta colocar =a função desejada, (célula inicial : que significa até e célula final para preencher o intervalo)
Exemplo:
=soma(a2:a10);
=soma(a2:a10);
=média(a2:a10);
=mínimo(a2:a10);
=máximo (a2:a10).
Para contagem:
Se quiser quantos aprovados ou reprovados tem numa tabela fica:
=cont.se(a2:a10;"aprovado ou reprovado")
Cuidado que nestes casos letras maiúsculas e minúsculas influenciam.
Se você quiser contar quantos números tem em uma lista a fórmula fica:
=cont.num(a2:a10)
=cont.num(a2:a10)
Para contar nomes:
=cont.valores(a2:a10)
=cont.valores(a2:a10)
Para calcular raíz quadrada você pode colocar por exemplo =raiz(a1) se em a1 tiver digitado um valor e se vc mudar o valor ele recalcula ou então =raiz(256)
Para calcular potência: =1^5
Para ver se um valor é verdadeiro ou falso: imagina em a1 o número 10 e em a2 o número 9 então vc pode fazer um comparativo.
=a2>a1 daria falso porque 9 é menor que 10 e =a2>a1 daria verdadeiro.
CÓDIGO VISUAL BASIC:
Sobreamento Linha com Coluna:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim RngRow As Range
Dim RngCol As Range
Dim RngFinal As Range
Dim Row As Long
Dim Col As Long
Rows.Interior.ColorIndex = xlNone
Columns.Interior.ColorIndex = xlNone
Row = Target.Row
Col = Target.Column
Set RngRow = Range("A" & Row, Target)
Set RngCol = Range(Cells(1, Col), Target)
Set RngFinal = Union(RngRow, RngCol)
RngFinal.Interior.ColorIndex = 43
End Sub
___________________________________________________________
Código extenso (para transcrever um valor por extenso):
Obs: Para que este código funcione na planilha do excel va em exibir código e crie um módulo para ai sim colar o código neste módulo
Function extenso(nValor As String) As String
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 * 250
aux = Trim(extenso) ' e alterar esta linha para trim(Extenso)
While Len(Trim(aux)) <> 250
aux = Trim(aux) & "-x"
Wend
extenso = aux
End Function
Function PorExtenso(nValor)
'Valida Argumento
If IsNull(nValor) Or nValor <= 0 Or nValor > 99999999.99 Then Exit Function
'Variáveis
Dim nContador, nTamanho As Integer
Dim cValor, cParte, cFinal As String
ReDim aGrupo(4), aTexto(4) As String
'Matrizes de 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 "
'Separa valor em 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)
'Calcula 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 'Final
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
PorExtenso = cFinal
End Function
_________________________________________________________________________________
Nenhum comentário:
Postar um comentário