Olá, no artigo de hoje vamos disponibilizar um código que tem a função de transforma números (real, moeda) em números por extenso (Texto). Isso tudo usando programação vba excel, o comando é de fácil adaptação explicaremos tudo nesse post.

O código foi o mesmo usado para o desenvolvimento de nossa planilha para emissão de recibos, ela possui a função que converte moeda em Números por extenso. Se você deseja saber mais, fique comigo até o final desse artigo.

Temos uma seção de comentários logo a baixo, sua opinião é importante para nós não deixe de comentar. E se for possível, compartilhe esse artigo para que outras pessoas possam dispor dessa função.

Números Por Extenso – Escrever Por Extenso No Excel VBA

Recebi no e-mail alguns pedidos similares a esse tópico, por esse fato surgiu à ideia de escrever o artigo. Uso bastante essa função em programas que desenvolvo, acredito que ele será de grande utilidade para você.

Busquei no Google e reparei que 10 mil a 100 mil pessoas pesquisam todos os meses sobre o assunto. Isso acontece porque essa função faz toda a diferença em nossos trabalhos, e economiza tempo do usuário que utilizará seu programa.

Explicando o código mais a fundo seria basicamente o seguinte:

Imagine que você crie uma aplicação em vba para emissão de recibos, sabemos que é comum em todo emissor ter o valor pago escrito por extenso. Isso já é um padrão que muitas pessoas (empresas) utilizam á bastante tempo.

Números por extenso - Escrever por extenso no excel vba modelo de recibio

Digamos que sua aplicação estar pronta, mas na hora de preencher as informações do recibo o valor por extenso precisa ser digitalizado. Muita das vezes isso se torna um processo demorado, principalmente para o usuário que irar utilizar sua aplicação.

Esse problema pode ser resolvido de modo muito simples, veja a baixo como funciona ó código na prática. Mas é importante ressaltar que isso depende do gosto de cada usuário.

Para essa questão estamos usando o emissor de recibos como exemplo, mas existem várias outras formas de adaptar o comando. Vou deixa o link da planilha aqui para você baixar o sistema, e também o bloco de notas com o código para você arquiva em seu computador.

Números por extenso - Escrever por extenso no excel vba modelo de recibio em gif

Observou como é bem mais prático quando adaptamos o código, vamos aprender agora na prática como usar a função. Irei disponibilizar um trabalho limpo clique aqui e baixe para seguir o tutorial.

Números Por Extenso – Aprendendo Usar O Comando No Excel VBA

O primeiro passo é você acessar seu painel de desenvolvimento no vba, depois no menu superior procura por INSERIR, logo após NOVO MÓDULO. Iremos construir toda a função dentro desse módulo.

Números por extenso - Escrever por extenso no excel vba código no módulo

Dentro do módulo você vai colar o seguinte código:

Function Extenso(dValor As Double) As String
Dim sMoeda As String
Dim dCents As Variant
'Se o valor for igual ou maior que 1 quatrilhão
'não será possível proceder com a função
If dValor > 999999999999999# Then
Extenso = "valor muito grande"
Exit Function
End If
'Se o valor for menor que 1 centavo, considerar-se-á zero para a função:
If dValor < 0.01 Then
Extenso = "zero reais"
Exit Function
End If
'Se o valor da unidade for igual a 1, a unidade está no singular
'Caso contrário, estará no plural.
If Fix(dValor) = 1 Then
sMoeda = " real"
Else
sMoeda = " reais"
End If
'Remove os centavos
dCents = dValor - Fix(dValor)
'Remove os centavos do valor
dValor = dValor - CDbl(dCents)
'Chamar função de extenso para os centavos
dCents = Centavos(CDbl(dCents) * 100)
'Caso a string seja diferente de branco e valor seja maior ou igual a 1
If dCents <> vbNullString And dValor >= 1 Then
'acrescentar uma vírgula antes do extenso
dCents = " e " & dCents
End If
'Iniciar o processo de conversao dos valores longos
sMoeda = Trim(Trilhões(dValor)) & sMoeda & dCents
sMoeda = Replace(sMoeda, ", e", " e")
sMoeda = Replace(sMoeda, ", r", " r")
If Left(sMoeda, 2) = "e " Then
sMoeda = Mid(sMoeda, 3, Len(sMoeda))
'ElseIf Left(sMoeda, 5) = "mil e" Then
'sMoeda = Mid(sMoeda, 5, Len(sMoeda))
End If
Extenso = sMoeda
End Function
Private Function Centavos(dValor As Double) As String
'Passa o valor para base decimal
dValor = Round(CDbl(dValor / 100), 2)
'Se for um centavo, escrever valor e sair da função
If dValor = 0.01 Then
Centavos = "um centavo"
Exit Function
End If
'Repassa valor para dezenas
dValor = dValor * 100
'Se nao houver dezenas no valor passado
If Dezenas(dValor) = vbNullString Then
'a string centavos fica em branco
Centavos = vbNullString
Else
'caso contrário, passar extenso das dezenas e concatenar
'com a palavra centavos
Centavos = Dezenas(dValor) & " centavos"
End If
End Function
Private Function Unidades(dValor As Double) As String
Dim Unid(9) As String
'Define as unidades a serem usadas
Unid(1) = "um": Unid(6) = "seis"
Unid(2) = "dois": Unid(7) = "sete"
Unid(3) = "três": Unid(8) = "oito"
Unid(4) = "quatro": Unid(9) = "nove"
Unid(5) = "cinco"
'Retorna a string referente a unidade passada para esta função:
Unidades = Unid(dValor)
End Function
Private Function Dezenas(dValor As Double) As String
Dim Dez1(9) As String
Dim Dez2(9) As String
Dim dDezena As Double
Dim dUnidade As Double
'Define as dezenas a serem utilizadas
Dez2(1) = "onze": Dez2(6) = "dezesseis"
Dez2(2) = "doze": Dez2(7) = "dezessete"
Dez2(3) = "treze": Dez2(8) = "dezoito"
Dez2(4) = "quatorze": Dez2(9) = "dezenove"
Dez2(5) = "quinze"
Dez1(1) = "dez": Dez1(6) = "sessenta"
Dez1(2) = "vinte": Dez1(7) = "setenta"
Dez1(3) = "trinta": Dez1(8) = "oitenta"
Dez1(4) = "quarenta": Dez1(9) = "noventa"
Dez1(5) = "cinquenta"
'Calcula o inteiro da dezena
dDezena = Fix(dValor / 10)
'Calcula o inteiro da unidade
dUnidade = dValor Mod 10
'Se o inteiro da dezena for zero
If dDezena = 0 Then
'dezenas sao iguais as unidades
Dezenas = Unidades(dUnidade)
Exit Function
Else
'caso contrário, é igual a dez
Dezenas = Dez1(dDezena)
End If
'Se o inteiro da dezena for igual a 1 e
'o inteiro da unidade for zero, os valores estão
'entre 11 e 19
If (dDezena = 1 And dUnidade > 0) Then
Dezenas = Dez2(dUnidade)
Else
'Caso contrário, valor está entre 20 e 90 inclusive
If (dDezena > 1 And dUnidade > 0) Then
'Concatena a string da dezena com a string da unidade
Dezenas = Dezenas & " e " & Unidades(dUnidade)
End If
End If
End Function
Private Function Centenas(dValor As Double) As String
Dim dCento As Double
Dim dDez As Double
Dim dUni As Double
Dim dUniMod As Double
Dim dModDez As Double
Dim sCento As String
Dim Cento(9) As String
'Define as centenas
Cento(1) = "cento": Cento(6) = "seiscentos"
Cento(2) = "duzentos": Cento(7) = "setecentos"
Cento(3) = "trezentos": Cento(8) = "oitocentos"
Cento(4) = "quatrocentos": Cento(9) = "novecentos"
Cento(5) = "quinhentos"
'Calcula o inteiro da centena
dCento = Fix(dValor / 100)
'Calcula a parte da dezena
dDez = dValor - (dCento * 100)
'Calcula o inteiro da unidade
dUni = Fix(dDez / 10)
'Calcula o resto da unidade
dUniMod = dUni Mod 10
'Calcula o resto da dezena
dModDez = dDez Mod 10
'Se centena for cem, definir string como "cem " e sair
If dValor = 100 Then
sCento = "cem "
Else
'Caso contrário definir a string da centena
sCento = Cento(dCento)
End If
'Avalia se a unidade é maior ou igual a zero, se o resto da unidade é igual ou
'maior que zero, se a dezena é maior ou igual a um e se a centena é igual ou
'maior que 1. Se forem verdadeiros, adicionar " e " à string da centena:
If (dUni >= 0 And dUniMod >= 0 And dDez >= 1 And dCento >= 1) Then
sCento = sCento & " e "
End If
'Concatena a string do cento com a string da dezena
Centenas = Trim(sCento & Dezenas(dDez))
End Function
Private Function Milhares(dValor As Double) As String
Dim dMilhar As Double
Dim dCento As Double
Dim sMilhar As String
'Calcula o inteiro da milhar
dMilhar = Fix(dValor / 1000)
'Calcula o cento dentro da milhar
dCento = dValor - (dMilhar * 1000)
'Se milhar for zero, entao a string da milhar fica em branco
If dMilhar = 0 Then sMilhar = vbNullString
If (dMilhar >= 1 And dMilhar < 10) Then
sMilhar = Unidades(dMilhar) & " mil, "
'Se for entre 10 e 100, então string igual a dezenas
ElseIf (dMilhar >= 10 And dMilhar < 100) Then
sMilhar = Dezenas(dMilhar) & " mil, "
'Se for entre 100 e 1000, então igual string centenas
ElseIf (dMilhar >= 100 And dMilhar < 1000) Then
sMilhar = Centenas(dMilhar) & " mil, "
End If
If (dCento >= 1 And dCento <= 100) Then sMilhar = sMilhar & "e "
Milhares = Trim(sMilhar & Centenas(dCento))
End Function
Private Function Milhões(dValor As Double) As String
'Mesma lógica usada pela rotina Milhares
Dim dMilhão As Double
Dim dMilhares As Double
Dim sMilhão As String
dMilhão = Int(dValor / 1000000)
dMilhares = dValor - (dMilhão * 1000000)
If dMilhão = 0 Then sMilhão = vbNullString
If (dMilhão = 1) Then
sMilhão = Unidades(dMilhão) & " milhão, "
ElseIf (dMilhão > 1 And dMilhão < 10) Then
sMilhão = Unidades(dMilhão) & " milhões, "
ElseIf (dMilhão >= 10 And dMilhão < 100) Then
sMilhão = Dezenas(dMilhão) & " milhões, "
ElseIf (dMilhão >= 100 And dMilhão < 1000) Then
sMilhão = Centenas(dMilhão) & " milhões, "
End If
If dValor = 1000000# Then sMilhão = "um milhão de "
Milhões = Trim(sMilhão & Milhares(dMilhares))
End Function
Private Function Bilhões(dValor As Double) As String
'Mesma lógica usada pela rotina Milhares
Dim dBilhão As Double
Dim dMilhão As Double
Dim sBilhão As String
dBilhão = Int(dValor / 1000000000)
dMilhão = dValor - (dBilhão * 1000000000)
If (dBilhão = 1) Then
sBilhão = Unidades(dBilhão) & " bilhão, "
ElseIf (dBilhão > 1 And dBilhão < 10) Then
sBilhão = Unidades(dBilhão) & " bilhões, "
ElseIf (dBilhão >= 10 And dBilhão < 100) Then
sBilhão = Dezenas(dBilhão) & " bilhões, "
ElseIf (dBilhão >= 100 And dBilhão < 1000) Then
sBilhão = Centenas(dBilhão) & " bilhões, "
End If
If dValor = 1000000000# Then sBilhão = "um bilhão de "
Bilhões = Trim(sBilhão & Milhões(dMilhão))
End Function
Private Function Trilhões(dValor As Double) As String
'Mesma lógica usada pela rotina Milhares
Dim dTrilhão As Double
Dim dBilhão As Double
Dim sTrilhão As String
dTrilhão = Int(dValor / 1000000000000#)
dBilhão = dValor - (dTrilhão * 1000000000000#)
If (dTrilhão = 1) Then
sTrilhão = Unidades(dTrilhão) & " trilhão, "
ElseIf (dTrilhão > 1 And dTrilhão < 10) Then
sTrilhão = Unidades(dTrilhão) & " trilhões, "
ElseIf (dTrilhão >= 10 And dTrilhão < 100) Then
sTrilhão = Dezenas(dTrilhão) & " trilhões, "
ElseIf (dTrilhão >= 100 And dTrilhão < 1000) Then
sTrilhão = Centenas(dTrilhão) & " trilhões, "
End If
If dValor = 1000000000000# Then sTrilhão = "um trilhão de "
Trilhões = Trim(sTrilhão & Bilhões(dBilhão))
End Function

Números Por Extenso – Configurações Gerais Do Sistema

Agora precisamos inserir o formulário com 2 textbox da seguinte forma:

Números por extenso - Escrever por extenso no excel vba código userform

Com o mouse de um duplo clique na primeira textbox, depois mude seu evento para Exit. Isso é necessário para que a formatação ocorra no momento em que sairmos de dentro do controle após digitar o valor. (Dar Enter)

Nesse evento vamos digitar o seguinte comando:

On Error Resume Next
Me.TextBox2 = UCase(Extenso(TextBox1))
Me.TextBox1 = FormatNumber(TextBox2)
TextBox1 = Format(TextBox1, "R$#,##0.00")

Esse código chama nossa função criada dentro do Módulo para escrever Números por extenso, sua aplicação estar pronta para uso. Veja como ficou a formatação na prática.

Números por extenso - Escrever por extenso no excel vba dentro da textbox gif

Bem com isso encerro o post sobre escrever Números por extenso no excel vba, se você gostou do artigo deixe aqui seu comentário. A baixo encontra-se o link para download da planilha.

→Link Para Baixar a Planilha Excel de Referência

Tags:

Sobre o Autor

Welisson Silva
Welisson Silva

Analista de Sistemas, trabalha com TI desde 2014. Especializado em Vendas Online, desenvolvedor, programador, guitarrista e entusiasta de tudo que envolva tecnologia.