Número por Extenso Excel VBA – Planilha de Recibo de Aluguel

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:

Baixe a planilha


Marcos Rieper

Pai, marido, professor e consultor em Excel.

Obrigado por ler este artigo, este blog foi criado para difundir o conhecimento em Excel à todos.

Divulgamos novos artigos nas redes sociais, basta clicar nos ícones abaixo.

Excel não precisa ser complicado

Assine nossa newsletter e receba dicas práticas para dominar o excel