Escrever Número Por Extenso

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.

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 Follow @exceldoseujeito também.
Um abraço.
 

Veja os Termos aprendidos neste artigo:

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