Função Excel para colocar número por extenso no Excel com VBA. Passo-a-passo de como aplicar em qualquer planilha.
No nosso exemplo iremos apresentar um exemplo de planilha para controle de recibos de aluguel.
Clique no vídeo abaixo para assistir como aplicar o código e como criar esta planilha de recibos de aluguel do zero.
Abaixo passo-a-passo como criar uma função própria no Excel e a aplicar na sua pasta de trabalho.
Planilha de Cadastro de Aluguéis
A primeira parte da planilha de recibos de aluguéis é a parte aonde temos o lançamento de todos os dados que serão utilizados no recibo de aluguel.
Nele temos:
- Nome: nome do locatário
- Endereço: endereço do imóvel
- Aluguel: casa, apartamento, sala.
- Tipo: residencial ou comercial.
- Valor aluguel: valor do aluguel
- Água / Luz: valor da água e luz.
- Impostos / Taxas: impostos e taxas do mês.
- Condomínio: Valor do condomínio.
- Outros: Outros valores como multas.
Todos estes dados serão utilizados no recibo e serão retornados para ele utilizando funções que ao selecionar o cliente já irá aparecer os dados do recibo.
Planilha de Recibo de Aluguel
Na planilha de recibo de aluguel você tem uma planilha de recibo de aluguéis em formato pronto para impressão, lembrando que a planilha de recibos de aluguel é gratuita.
Ao selecionar o locatário ao topo, automaticamente todos os dados são retornados da planilha de cadastro de aluguéis.
Agora que vimos aonde será aplicado o exemplo de número por extenso no Excel, veja abaixo como a aplicar.
Habilitar as Macros no Excel
Para aplicar uma função própria no Excel a primeira parte é necessário primeiro habilitar as macros no seu Excel, faça desta forma.
Para habilitar a guia desenvolvedor no Excel VBA clique neste link: https://www.guiadoexcel.com.br/habilitar-guia-desenvolvedor-no-excel-e-copiar-procedimentos-vba/
Após isso podemos incluir uma nova função própria no Excel, ela será responsável por retornar o número por extenso no Excel.
Número por Extenso no Excel com VBA
Para aplicar o número por extenso no Excel clique na guia Desenvolvedor e no botão Visual Basic.
Com o VBE (Visual Basic Editor) aberto clique na guia Inserir->Módulo.
Ficará desta forma o módulo inserido:
Após isso nós iremos colocar o código VBA responsável pela função de número por extenso.
Uma vez inclusa, esta função ficará disponível na pasta de trabalho e poderá inclusive ser aberta em outro computador sem problemas.
Copie e cole o código abaixo no módulo inserido.
Function fExtenso(Num As Double, Optional FraçTipo As Integer, Optional UndNomeSing As String, _
Optional UndNomePlur As String, Optional UndMasc As Boolean = True, _
Optional UmMil As Boolean = True, Optional VirgEntrMilh As Boolean = False, _
Optional CaixaAlta As Long = 1) As String
Dim ExtensInt As String
Dim ExtensFrac As String
Dim UndNome As String
Dim FracNome As String
Dim Signif As Long
Dim NumText As String
If Num > 999999999999.99 Or Num < 0 Then
fExtenso = "Erro! (Valores válidos: >=0 e < 1 trilhão)"
Exit Function
End If
'Preparando nome da unidade, singular e plural
If UndNomePlur = "" Then UndNomePlur = IIf(UndNomeSing = "", "", Pluralizar(UndNomeSing))
'Se a função Pluralizar falhar palavras estrangeiras ou em exceções portuguesas, o argumento UndNomePlur pode ser usado.
'Extenso parte inteira
ExtensInt = fExtensoInt(Int(CDec(Num)), UndMasc, UmMil, VirgEntrMilh)
'Extenso parte fracionária
If FraçTipo = 0 And UndNomeSing = "" Then FraçTipo = 3
If FraçTipo = 0 And UndNomeSing <> "" Then FraçTipo = 1
Select Case FraçTipo
Case 1, 5 'Lê fração em centavos ou cêntimos. Ideal para Moeda
Num = Format(Num, "0.00") * 1 'Round(Num,2)
ExtensFrac = fExtensoInt((Num - Int(CDec(Num))) * 100, True, UmMil, VirgEntrMilh)
If ExtensInt = "" And ExtensFrac = "" Then ExtensInt = "zero"
'Nome da unidade no singular ou plural
UndNome = IIf(Num < 1, IIf(Num = 0, " " & UndNomePlur, ""), IIf(UndNomeSing = "" Or Right(ExtensInt, 1) = " ", "", " ") & IIf(Int(CDec(Num)) = 1, UndNomeSing, UndNomePlur) & IIf(Num = Int(CDec(Num)), "", " e "))
'Nome da fração no singular ou plural
FracNome = IIf(Num = Int(CDec(Num)), "", IIf(Int(CDec(Num * 100)) - Int(CDec(Num)) * 100 = 1, IIf(FraçTipo = 5, " cêntimo", " centavo"), IIf(FraçTipo = 5, " cêntimos", " centavos")))
fExtenso = ExtensInt & UndNome & ExtensFrac & FracNome
Case 2 'Lê a vírgula decimal, cada zero e o número restante como inteiro. Ideal para percentual.
ExtensFrac = Num - Int(CDec(Num))
If ExtensFrac = 0 Then
fExtenso = ExtensInt
Else
ExtensFrac = Format(ExtensFrac, "0.############")
ExtensFrac = Mid(ExtensFrac, 3, 15)
fExtenso = IIf(ExtensInt = "", "zero", ExtensInt) & " vírgula"
Do While Left(ExtensFrac, 1) = "0"
fExtenso = fExtenso & " zero"
ExtensFrac = Mid(ExtensFrac, 2, 15)
Loop
fExtenso = fExtenso & " " & fExtensoInt(ExtensFrac * 1, UndMasc, UmMil, VirgEntrMilh)
End If
If fExtenso = "" Then fExtenso = "zero"
fExtenso = fExtenso & IIf(UndNomeSing <> "", " ", "") & IIf(Num = 1, UndNomeSing, UndNomePlur)
Case 3 'Lê a fração de décimo a bilionésimo. Ideal para número puro.
ExtensFrac = Num - Int(CDec(Num))
If ExtensFrac = 0 Then
ExtensFrac = ""
Else
ExtensFrac = Format(ExtensFrac, "0.############")
Signif = Len(ExtensFrac) - 2
If Signif > 3 And Signif <> 6 And Signif <> 9 And Signif <> 12 Then Signif = Int(CDec(Signif / 3)) * 3 + 3
If Signif > 0 Then
ExtensFrac = Format(ExtensFrac, "0.000000000000")
ExtensFrac = fExtensoInt(Mid(ExtensFrac, 3, Signif) * 1, True, UmMil, VirgEntrMilh)
FracNome = Choose(Signif, "décimo", "centésimo", "milésimo", , , "milionésimo", , , "bilionésimo", , , "trilionésimo")
FracNome = " " & FracNome & IIf(ExtensFrac = "um", "", "s")
Else
ExtensFrac = ""
End If
End If
If ExtensInt = "" And ExtensFrac = "" Then ExtensInt = "zero"
If UndNomeSing = "" Then
fExtenso = ExtensInt & IIf(ExtensInt <> "" And ExtensFrac <> "", ", e ", "") & ExtensFrac & FracNome
Else
'Nome da unidade no singular ou plural
UndNome = IIf(Num < 1, IIf(Num = 0, " " & UndNomePlur, ""), IIf(UndNomeSing = "" Or Right(ExtensInt, 1) = " ", "", " ") & IIf(Int(CDec(Num)) = 1, UndNomeSing, UndNomePlur) & IIf(Num = Int(CDec(Num)), "", " e "))
'Nome da fração no singular ou plural
FracNome = IIf(Num = Int(CDec(Num)), "", FracNome & " de " & UndNomeSing)
fExtenso = ExtensInt & UndNome & ExtensFrac & FracNome
End If
Case 4 'Não lê a fração mas escreve como fração com um denominador de 100, 1000, 1000000... Ideal para moeda com fração de milésimo
ExtensFrac = Num - Int(CDec(Num))
If ExtensFrac = 0 Then
ExtensFrac = "nenhum/100"
Else
ExtensFrac = Format(ExtensFrac, "0.############")
Signif = Len(ExtensFrac) - 2
If Signif > 3 And Signif <> 6 And Signif <> 9 And Signif <> 12 Then Signif = Int(CDec(Signif / 3)) * 3 + 3
If Signif > 1 Then
ExtensFrac = (Num - Int(CDec(Num))) * 10 ^ Signif
ExtensFrac = ExtensFrac & "/" & 10 ^ Signif
Else
ExtensFrac = (Num - Int(CDec(Num))) * 10 ^ 2
ExtensFrac = ExtensFrac & "/100"
End If
End If
If ExtensInt = "" Then ExtensInt = "zero"
'Nome da unidade no singular ou plural
UndNome = IIf(Int(CDec(Num)) = 1, UndNomeSing, UndNomePlur)
fExtenso = ExtensInt & " " & UndNome & " e " & ExtensFrac
End Select
Select Case CaixaAlta
Case 1
fExtenso = LCase(fExtenso)
Case 2
fExtenso = UCase(Left(fExtenso, 1)) & Mid(fExtenso, 2)
Case 3
fExtenso = StrConv(fExtenso, vbProperCase)
fExtenso = MyReplace(fExtenso, " E ", " e ")
Case 4
fExtenso = StrConv(fExtenso, vbUpperCase)
End Select
'Preservar caixa alta de letra antes de ponto em UndNome
Dim lPos As Long
Dim lPos1 As Long
Do While InStr(lPos + 1, UndNome, ".") > 1
lPos = InStr(lPos + 1, UndNome, ".")
lPos1 = InStr(lPos1 + 1, fExtenso, ".")
fExtenso = Left(fExtenso, lPos1 - 2) & Mid(UndNome, lPos - 1, 1) & Mid(fExtenso, lPos1)
Loop
End Function
Private Function fExtensoInt(Num As Double, UndMasc As Boolean, UmMil As Boolean, VirgEntrMilh As Boolean) As String
'Gramática portuguesa:
'Regra Geral: Não se intercala a conjunção 'e' e nem vírgula entre posições de milhar.
'Exceção: Se a milhar posterior for menor que 100 ou for centena inteira (100,200,300...)
'Alguns gramáticos não aceitam essa exceção e outros já aceitam a vírgula.
'A variável ConjExc ativa/desativa a exceção
'A variável VirgEntrMilh usa vírgula entre milhares
Dim NumText As String
Dim Ce As String
Dim Ma As String
Dim Mõ As String
Dim Bi As String
Dim f As String
Dim ConjExc As Boolean
ConjExc = True
If VirgEntrMilh Then ConjExc = False
If Num = 0 Then
fExtensoInt = ""
Exit Function
End If
NumText = Format(Num, "000,000,000,000")
'1º Posição de milhar, Centenas
Ce = Mid(NumText, 13, 3)
'2º Posição de milhar, Milhares
Ma = Mid(NumText, 9, 3)
'3º Posição de milhar, Milhões
Mõ = Mid(NumText, 5, 3)
'4º Posição de milhar, Bilhões
Bi = Mid(NumText, 1, 3)
f = fMilharText(Bi, UndMasc) & IIf(Bi > 0, IIf(Bi > 1, " bilhões", " bilhão"), "")
f = f & IIf(VirgEntrMilh And Bi > 0 And Mõ > 0, ", ", IIf(Bi > 0 And Mõ > 0, " ", ""))
f = f & IIf(ConjExc And Bi > 0 And Mõ > 0 And (Mõ < 100 Or Right(Mõ, 2) = "00"), "e ", "")
f = f & fMilharText(Mõ, UndMasc) & IIf(Mõ > 0, IIf(Mõ > 1, " milhões", " milhão"), "")
f = f & IIf(VirgEntrMilh And Bi + Mõ > 0 And Ma > 0, ", ", IIf(Bi + Mõ > 0 And Ma > 0, " ", ""))
f = f & IIf(ConjExc And Bi + Mõ > 0 And Ma > 0 And (Ma < 100 Or Right(Ma, 2) = "00"), "e ", "")
f = f & fMilharText(Ma, UndMasc) & IIf(Ma > 0, IIf(Ma > 1, " mil", " mil"), "")
If Not UmMil Then If f = "um mil" Then f = "mil" 'Omitir 'um' em 'um mil'
f = f & IIf(VirgEntrMilh And Bi + Mõ + Ma > 0 And Ce > 0, ", ", IIf(Bi + Mõ + Ma > 0 And Ce > 0, " ", ""))
f = f & IIf(ConjExc And Bi + Mõ + Ma > 0 And Ce > 0 And (Ce < 100 Or Right(Ce, 2) = "00"), "e ", "")
f = f & fMilharText(Ce, UndMasc) & IIf(Ce > 0, ",", "")
f = IIf(Right(f, 1) = ",", Mid(f, 1, Len(f) - 1), f)
f = IIf(Right(f, 2) = "ão", f & " de", f)
f = IIf(Right(f, 3) = "ões", f & " de", f)
fExtensoInt = f
End Function
Private Function fMilharText(NumText As String, UndMasc As Boolean)
'Gramática portuguesa:
'Regra Geral: Intercala-se a conjunção 'e' entre centenas, dezenas e unidades
Dim UndText As String
Dim DezenaText As String
Dim CentenaText As String
Const ConjDez_Un = " e " 'Conjunção entre Dezena e Unidade
Const ConjCen_Dez = " e " 'Conjunção entre Centena e Unidade
' Unidade texto
If Mid(NumText, 2, 1) <> "1" Then
UndText = Choose(Mid(NumText, 3, 1) + 1, "", IIf(UndMasc, "um", "uma"), _
IIf(UndMasc, "dois", "duas"), "três", "quatro", "cinco", "seis", _
"sete", "oito", "nove")
Else
UndText = ""
End If
'Dezena texto
If Mid(NumText, 2, 1) <> "1" Then
DezenaText = Choose(Mid(NumText, 2, 1) + 1, "", "dez", "vinte", _
"trinta", "quarenta", "cinqüenta", "sessenta", "setenta", _
"oitenta", "noventa")
Else
DezenaText = Choose(Mid(NumText, 3, 1) + 1, "dez", "onze", _
"doze", "treze", "quatorze", "quinze", "dezesseis", _
"dezessete", "dezoito", "dezenove")
End If
'Centena texto
If UndMasc Then
CentenaText = Choose(Mid(NumText, 1, 1) + 1, "", "cento", "duzentos", _
"trezentos", "quatrocentos", "quinhentos", "seiscentos", _
"setecentos", "oitocentos", "novecentos")
Else
CentenaText = Choose(Mid(NumText, 1, 1) + 1, "", "cento", "duzentas", _
"trezentas", "quatrocentas", "quinhentas", "seiscentas", _
"setecentas", "oitocentas", "novecentas")
End If
If Mid(NumText, 1, 1) = "1" And Mid(NumText, 2, 2) = "00" Then CentenaText = "cem"
'Milhar texto
fMilharText = CentenaText & IIf(Mid(NumText, 2, 2) * 1 > 0 And CentenaText <> "", ConjCen_Dez, "") _
& DezenaText & IIf(Mid(NumText, 2, 2) * 1 <= 19 Or Right(NumText, 1) = "0", "", ConjDez_Un) _
& UndText
End Function
Function Pluralizar(Sing As String) As String
Dim e As String
Dim IsLCase As Boolean
IsLCase = Right(Sing, 1) = LCase(Right(Sing, 1))
'Regra geral:
Pluralizar = IIf(Sing = "", "", Sing & IIf(IsLCase, "s", "S"))
'Exceções: (Quase todas)
' Nomes terminados em al, el, ol, ul, il
e = LCase(Right(Sing, 2))
If e = "al" Or e = "el" Or e = "ol" Or e = "ul" Or e = "il" Then Pluralizar = Left(Sing, Len(Sing) - 1) & IIf(IsLCase, "is", "IS")
'Nomes terminados em il
If e = "il" Then Pluralizar = Left(Sing, Len(Sing) - 2) & IIf(IsLCase, "is", "IS")
' Nomes terminados em r, s, z
e = LCase(Right(Sing, 1))
If e = "r" Or e = "s" Or e = "z" Then Pluralizar = Sing & IIf(IsLCase, "es", "ES")
' Nomes terminados em m
If e = "m" Then Pluralizar = Left(Sing, Len(Sing) - 1) & IIf(IsLCase, "ns", "NS")
' Nomes terminados em x
If e = "x" Then Pluralizar = Sing
End Function
Private Function MyReplace(vText As String, vTxtFind As String, vTxtRep As String)
'Word 6.0 VBA doesn't have Replace function
Dim lPos As Long
lPos = 1 - Len(vTxtRep)
vStart:
lPos = InStr(lPos + Len(vTxtRep), vText, vTxtFind)
If lPos = 0 Or vTxtFind = "" Then
MyReplace = vText
Exit Function
End If
vText = Left(vText, lPos - 1) & vTxtRep & Right(vText, Len(vText) - lPos - Len(vTxtFind) + 1)
GoTo vStart
End Function
Após isso você terá o código como vemos abaixo, já devidamente formatado e colorido com as variáveis, códigos e comentários.
Utilizar a Função Valor por Extenso
Para utilizar a função de valor por extenso é bastante simples.
Basta chamar a função fExtenso diretamente no Excel e no primeiro parâmetro passar o valor que deseja que seja colocado por extenso.
A função também possui vários parâmetros, como a moeda que será utilizada.
No nosso exemplo usamos a seguinte fórmula: =MAIÚSCULA(@fExtenso(D14;;”Real”;”Reais”;;;;0))
Desta forma você terá o valor o valor por extenso e também em maiúsculo.
Como resultado ficará assim:
Download da Planilha de Número por Extenso Excel
Clique no botão abaixo para realizar o download do arquivo de exemplo:
