Olá queridos leitores.

Hoje disponibilizo a vocês uma formulazinha muito importante no nosso cotidiano. E aproveito para refletir um pouco. Por que será que o Excel já não disponibiliza nativamente uma função para executar a leitura de um número por extenso? Caramba! Que fórmula chatinha de desenvolver! Visto do ponto que o resultado é algo tão simples. Para vocês terem uma idéia, para que o excel escreva cem reais, por exemplo, ele tem que verificar se existem casas decimais, quantos algarismos possui o número, a que grupo de milhar ou centena pertence, se a unidade é decimal ou não, se o valor é maior ou igual a cem, porque se for 100, escreve-se “cem”, se for 101 ou mais, escreve-se “cento”. Haja paciência. Isto sem contar nos conectores do tipo “e”, “reais” ou “centavos”. Diferenciando-se, valores unitários dos demais, para definir se o termo virá no singular ou no plurar.

Apesar de tudo isso, essa fórmula é essencial ao nosso uso. Muitas aplicações ficam mais apresentáveis e profissionais com sua aplicação. Uma planilha de recibo por exemplo. Onde se exibe o valor pago, fica bem mais perfeito e atraente se estiver esse valor descrito de forma textual também. até mesmo se o intuito for imprimir. Bem mais aceitável.

Mas como não estou aqui para reclamar, tenho uma sugestão: Vamos começar logo porque senão vamos perder o jantar…

 

Iniciando o projeto

 

No excel vamos criar uma função personalizada que irá fazer os cálculos e análises num módulo do projeto VBA e será acessada diretamente na célula onde deseja exibir o resultado. Falei um pouco sobre a diferença entre function e sub no artigo sobre Contar Células Coloridas.

Chame a fórmula assim:

=ConverterParaExtenso(A2)

Onde A2 é onde se encontra o valor a descrever por extenso.

EscreveExtenso_p

Não vou me deter muito em exlicações detalhadas, visto que, a maioria do processo é de fácil conhecimento e entendimento. É apenas um procedimento de muito cálculo e análise. Portanto, preste bastante atenção.

 

O Código

 

O código abaixo deve ser escrito num Módulo. Farei alguns comentários em seguida.

 

 

Public Function ConverterParaExtenso(NumeroParaConverter As String) As String
Dim sExtensoFinal As String, sExtensoAtual As String
Dim i As Integer
Dim iQtdGrupos As Integer
Dim sDecimais As String
Dim sMoedaSing As String, sMoedaPlu As String, sCentavos As String
Dim bSufMoeda As Boolean

'Separa os Decimais
If InStr(1, NumeroParaConverter, ",") > 0 Then
sDecimais = Right(NumeroParaConverter, Len(NumeroParaConverter) - InStr(1, NumeroParaConverter, ","))
NumeroParaConverter = Mid(NumeroParaConverter, 1, InStr(1, NumeroParaConverter, ",") - 1)
End If

'Obtém a separação de milhares
iQtdGrupos = Fix(Len(NumeroParaConverter) / 3)
If Len(NumeroParaConverter) Mod 3 > 0 Then
iQtdGrupos = iQtdGrupos + 1
End If

'Chama as funções para escrever o número
If iQtdGrupos > 2 Then bSufMoeda = True

For i = iQtdGrupos To 1 Step -1
sExtensoAtual = DesmembraValor(NumeroParaConverter, i)
If i = 1 Then
If sExtensoAtual = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
If sExtensoFinal = "" Then
sExtensoFinal = sExtensoFinal & sExtensoAtual
Else
sExtensoFinal = sExtensoFinal & " e " & sExtensoAtual
End If
End If
Else
sExtensoFinal = sExtensoFinal & sExtensoAtual
End If

If iQtdGrupos > 2 Then
Select Case i
Case 1, 2
If sExtensoAtual <> "" Then
bSufMoeda = False
End If
End Select
End If
Next i

'Define a moeda
sMoedaPlu = " reais"
sMoedaSing = " real"

If bSufMoeda = True Then sMoedaPlu = " de reais"

'Escreve os Centavos
sCentavos = EscreveCentavos(sDecimais)

'Adiciona a moeda e os centavos
sExtensoFinal = IIf((sExtensoFinal = ""), "", sExtensoFinal & IIf((sExtensoFinal = "um"), sMoedaSing, sMoedaPlu)) _
& IIf((sExtensoFinal = ""), sCentavos, IIf((sCentavos = ""), "", " e " & sCentavos))

'retorna o resultado
ConverterParaExtenso = sExtensoFinal

End Function

Private Function DesmembraValor(sValor As String, iGrupoDiv As Integer) As String
Dim iValor As Integer
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim iPosInicMid As Integer
Dim iTamMid As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim vArrCentena As Variant

vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")

vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")

vArrCentena = Array("cem", "cento", "duzentos", "trezentos", "quatrocentos", _
"quinhentos", "seiscentos", "setecentos", "oitocentos", "novecentos")

'Pega o Valor a ser escrito e desmembra para o grupo numérico correto
iPosInicMid = Len(sValor) - ((3 * iGrupoDiv) - 1)
If iPosInicMid <= 1 Then
iTamMid = 2 + iPosInicMid
Else
iTamMid = 3
End If

If iPosInicMid < 1 Then iPosInicMid = 1

iValor = CInt(Mid(sValor, iPosInicMid, iTamMid))

Select Case iGrupoDiv
Case 2
sComplemento = " mil "
Case 3
If iValor = 1 Then
sComplemento = " milhão "
Else
sComplemento = " milhões "
End If
Case 4
If iValor = 1 Then
sComplemento = " bilhão "
Else
sComplemento = " bilhões "
End If
Case 5
If iValor = 1 Then
sComplemento = " trilhão "
Else
sComplemento = " trilhões "
End If
End Select

Select Case iValor
Case 0 To 19
sExtenso = vArrDez1(iValor)
Case 20 To 99
iDivInteiro = Fix(iValor / 10)
iDivResto = iValor Mod 10

If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
Case 100 To 999
iDivInteiro = Fix(iValor / 100)
iDivResto = iValor Mod 100

If iDivResto = 0 Then
If iDivInteiro = 1 Then
sExtenso = vArrCentena(0)   'Cem
Else
sExtenso = vArrCentena(iDivInteiro) 'inteiro maior que 100
End If
Else
sExtenso = vArrCentena(iDivInteiro) & " e "
Select Case iDivResto
Case 0 To 19
sExtenso = sExtenso & vArrDez1(iDivResto)
Case 20 To 99
iDivInteiro2 = Fix(iDivResto / 10)
iDivResto2 = iDivResto Mod 10

If iDivResto2 = 0 Then
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2)
Else
sExtenso = sExtenso & vArrDez2(iDivInteiro2 - 2) & " e " & vArrDez1(iDivResto2)
End If
End Select
End If

End Select

DesmembraValor = sExtenso & IIf(iValor > 0, sComplemento, "")
End Function

Private Function EscreveCentavos(sCent As String) As String
Dim sExtenso As String
Dim iDivResto As Integer
Dim iDivInteiro As Integer
Dim sComplemento As String
Dim vArrDez1 As Variant
Dim vArrDez2 As Variant
Dim iCent As Integer

vArrDez1 = Array("", "um", "dois", "três", "quatro", "cinco", "seis", "sete", "oito", "nove", _
"dez", "onze", "doze", "treze", "quatorze", "quinze", "dezesseis", "dezessete", _
"dezoito", "dezenove")

vArrDez2 = Array("vinte", "trinta", "quarenta", "cinquenta", "sessenta", _
"setenta", "oitenta", "noventa")

'Adequando para duas casas decimais
iCent = Fix(sCent & String(2 - Len(sCent), "0"))

'Escrevendo Singular ou plural
If iCent = 1 Then
sComplemento = " centavo"
Else
sComplemento = " centavos"
End If

'Calculando os valores
Select Case iCent
Case 0 To 19
sExtenso = vArrDez1(iCent)
Case 20 To 99
iDivInteiro = Fix(iCent / 10)
iDivResto = iCent Mod 10

If iDivResto = 0 Then
sExtenso = vArrDez2(iDivInteiro - 2)
Else
sExtenso = vArrDez2(iDivInteiro - 2) & " e " & vArrDez1(iDivResto)
End If
End Select

EscreveCentavos = IIf(iCent > 0, sExtenso & sComplemento, "")
End Function

 

Explicando a Macro VBA.

 

 

 

Existem três funções no código:

  • Public Function ConverterParaExtenso(NumeroParaConverter As String) As String
  • Private Function DesmembraValor(sValor As String, iGrupoDiv As Integer) As String
  • Private Function EscreveCentavos(sCent As String) As String

 

Vamos começar pela mais simples, EscreveCentavos. Esta função é privada, portanto é disponível apenas ao acesso interno. Ela verifica a presença de decimais e escreve seu conteúdo.

Nas linhas 178 a 183 foram declaradas duas matrizes que contém os valores textuais para os números de 1 a 19 e de 20 a 90, em múltiplos de 10, respectivamente.

Nas linhas 189 a 193, efetua-se uma verificação para saber se o valor textual para o termo “centavos” deve estar no singular, no caso de apenas 1 centavo, ou no plural, para os demais valores.

Nas linhas de 196 a 208 são feitos todos os cálculos e atribuições de valores. Descobrindo-se o valor em número e substituindo-o pelo seu correspondente textual armazenado nas matrizes definidas no início.

Por fim, na linha 210 é exibido o resultado obtido, atentando-se ao fato de que se não houver valor nenhum, ou seja, 0 centavos, será retornado vazio.

Na função DesmembraValor, segue-se o mesmo raciocínio, apenas com algumas adições como, por exemplo, nas linhas de 90 a 100, a verificação à qual grupo de milhar ou centena pertence o número analizado.

Nas linhas de 102 a 123, define-se os termos identificadores do grupo. Milhões, bilhões, trilhões. E analisando, é claro, se estão no singular ou no plural. De 125 a 164 é feito todo o cálculo para definir as expressões textuais dos números baseando-se nas matrizes definidas anteriormente.

Enfim, a função que será acessada pelo Excel, ConverterParaExtenso. Nas linhas de 24 a 48 é realizado um loop para executar a função que excreve o valor por extenso de cada grupo numérico separadamente. A função para tal é chamada na linha 25. Em seguida, ainda dentro do loop são feitas verificações para definir conectores do tipo “e” e “moeda”.

Na linha 57 executamos a leitura dos centavos. Nas linhas 60 e 61, juntamos tudo. E, por fim, na linha 64, enviamos o resultado para a função retornar à célula que a chamou.

 

Não é complicado, apenas extenso. Disponibilizei o arquivo com esta macro prontinha para download no fim deste artigo, ok.

Amigos, obrigado pelo seu prestígio. Aguardo vocês sempre. Assine grátis nossa newsletter e também.

Um abraço.

 

Veja os Termos aprendidos neste artigo:

 

InStr Retorna uma Variant (Long) que especifica a posição da primeira ocorrência de uma seqüência de caracteres dentro de outra.SintaxeInStr([start, ]string1, string2[, compare])

A sintaxe da função InStr tem os seguintes argumentos:

Parte Descrição
start Opcional. Expressão numérica que define a posição inicial de cada pesquisa. Se omitido, a pesquisa iniciará na posição do primeiro caractere. Se start contiver Null, ocorrerá um erro. O argumento start será necessário, se compare for especificado.
string1 Obrigatória. Expressão de seqüência sendo pesquisada.
string2 Obrigatória. Expressão de seqüência de caracteres procurada.
compare Opcional. Especifica o tipo de comparação de seqüência de caracteres. Se compare for Null, ocorrerá um erro. Se compare for omitido, a configuração Option Compare determinará o tipo de comparação. Especifique um LCID (LocaleID) válido para usar regras específicas da localidade na comparação.

Definições

As configurações do argumento compare são as seguintes:

Constante Valor Descrição
vbUseCompareOption -1 Executa uma comparação usando a configuração da instrução Option Compare.
vbBinaryCompare 0 Executa uma comparação binária.
vbTextCompare 1 Executa uma comparação textual.
vbDatabaseCompare 2 Somente Microsoft Access. Efetua uma comparação, com base nas informações existentes no banco de dados.

Valores retornados

Se A InStr retornará
string1 tiver comprimento zero 0
string1 for Null Null
string2 tiver comprimento zero start
string2 for Null Null
string2 não for encontrado 0
string2 for encontrado dentro de string1 A posição em que a correspondência foi encontrada
start > string2 0
Len Retorna um Long que contém o número de caracteres existentes em uma seqüência de caracteres ou o número de bytes necessários para armazenar uma variável.SintaxeLen(string | varname)

A sintaxe da função Len tem as seguintes partes:

Parte Descrição
String Qualquer expressão de seqüência válida. Se string contiver Null, será retornado Null.
Varname Qualquer nome de variável válido. Se varname contiver Null, será retornado Null. Se varname for uma Variant, Len tratará essa variante como uma String e retornará sempre o número de caracteres nela contidos.
Mid Retorna uma Variant (String) que contém um número especificado de caracteres de uma seqüência de caracteres.SintaxeMid(string, start[, length])

A sintaxe da função Mid tem os seguintes argumentos nomeados:

Parte Descrição
string Obrigatória. Expressão de seqüência da qual são retornados os caracteres. Se string contiver Null, será retornado Null.
start Obrigatória; Long. A posição do caractere em string onde a parte a ser considerada começa. Se start for maior que o número de caracteres existentes em string, a função Mid retornará uma seqüência de caracteres de comprimento zero (“”).
length Opcional; Variant (Long). Número de caracteres a ser retornado. Se omitido ou se existirem menos caracteres do que os de length no texto (inclusive o caractere em start), serão retornados todos os caracteres a partir da posição start até o final da seqüência de caracteres.

Comentários

Para determinar o número de caracteres em string, use a função Len.

Right Retorna uma Variant (String) que contém um número especificado de caracteres, a partir do lado direito de uma seqüência de caracteres.SintaxeRight(string, length)

A sintaxe da função Right tem os seguintes argumentos nomeados:

Parte Descrição
string Obrigatória. Expressão de seqüência da qual serão retornados os caracteres da extrema direita. Se string contiver Null, será retornado Null.
length Obrigatória; Variant (Long). Expressão numérica que indica a quantidade de caracteres a ser retornada. Se for 0, será retornada uma seqüência de caracteres de comprimento zero (“”). Quando for maior ou igual ao número de caracteres em string, será retornada a seqüência de caracteres inteira.
Array Retorna um Variant contendo uma matriz.SintaxeArray(arglist)

O argumento obrigatório arglist é uma lista de valores delimitados por vírgulas que são atribuídos aos elementos da matriz contidos dentro de Variant. Se nenhum argumento for especificado, uma matriz de tamanho zero será criada.

Comentários

A notação usada para referir-se a um elemento de uma matriz consiste no nome de uma variável seguido por um número de índice entre parênteses indicando o elemento desejado. No exemplo a seguir, a primeira instrução cria uma variável denominada A como um Variant. A segunda instrução atribui uma matriz à variável A. A última instrução atribui o valor contido no segundo elemento de matriz a outra variável.

Dim A As Variant
A = Array(10,20,30)
B = A(2)

Antes de efetuar o download do arquivo de exemplo, convido você a socializar conosco.

Escolha uma das opções abaixo. Seguir no twitter, assinar nossa Newsletter...

Isso nos ajuda na divulgação do site e te permite ficar sempre atualizado das novidades. Fico muito grato pela sua colaboração.

Digite seu email:

Você receberá um email para ativar o cadastro, ok!