Olá pessoas Excelentes!
E aí? Tudo bem! Estão curtindo nossa promoção de Natal? O Sorteio será dia 24 de dezembro. Ainda dá tempo. Participem!
A dica de hoje é uma adaptação e melhoria na macro que converte qualquer número escrito numa célula para seu valor correspondente em extenso. Ou seja, um número como “R$ 9,90“, por exemplo, retornará “nove reais e noventa centavos” como resultado da fórmula. Essa funcionalidade é muito utilizada em holerites, recibos, comprovantes ou qualquer outra aplicação contábil que necessite alguma planilha.
Na publicação original, ensinei como converter um número no formato da nossa moeda brasileira, o Real. Contudo, um leitor informou sua necessidade de converter para outros formatos de moeda automaticamente de acordo com a formatação que se encontrasse o número na célula.
Vou explicar como fazer para as moedas Dólar e Euro, além do Real, é claro.
A pergunta do leitor
Com relação ao valor por extenso, quero utilizar para REAIS, DÓLAR E EURO.
Essa informação constará em uma célula (Tipo de moeda), tens que como a fórmula escrever por extenso a moeda correspondente.
Comentário feito pelo leitor Vanderlei
Respondendo a questão
Se você já leu o artigo anterior vai ficar feliz em saber que o comando mágico que permitirá realizar essa proeza será obtido pela propriedade NumberFormat do objeto Range. Serão poucas as modificações. Apenas vamos fazer a comparação do formato aplicado na célula e atribuir o nome da moeda corretamente.
Alguns pontos importantes:
O parâmetro passado na fórmula não poderá mais ser textual. Deverá ser um objeto Range, que corresponde a célula que contêm o número que será convertido para texto. Por quê? Precisamos da referência da célula para podermos verificar o formato nela aplicado. Somente assim será possível identificar a moeda utilizada.
No código original, nós definimos a moeda pelas linhas de comando abaixo:
sMoedaPlu = " reais"
sMoedaSing = " real"
If bSufMoeda = True Then sMoedaPlu = " de reais"
Agora, vamos condicioná-la de acordo com a verificação feita na informação obtida de NumberFormat. Lembrando que o parâmetro recebido pela função agora é do tipo Range e nomeado como rngNumeroParaConverter, teremos:
'Define a moeda
If InStr(1, rngNumeroParaConverter.NumberFormat, "$$") > 0 Then 'Dolar
sMoedaPlu = " dólares"
sMoedaSing = " dólar"
If bSufMoeda = True Then sMoedaPlu = " de dólares"
ElseIf InStr(1, rngNumeroParaConverter.NumberFormat, "€") > 0 Then 'Euro
sMoedaPlu = " euros"
sMoedaSing = " euro"
If bSufMoeda = True Then sMoedaPlu = " de euros"
Else 'Reais
sMoedaPlu = " reais"
sMoedaSing = " real"
If bSufMoeda = True Then sMoedaPlu = " de reais"
End If
Viu como é fácil! Você poderá adicionar mais condições para cada moeda diferente que você utilize.
A forma de utilizar a fórmula continua o mesmo. Se o número estiver na célula A1, na célula que quiser exibir o valor por extenso digite:
=ConverterParaExtenso(A1)
O código completo
Deverá ser colocado em um módulo.
Public Function ConverterParaExtenso(rngNumeroParaConverter As Range) 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
Dim NumeroParaConverter As String
Application.Volatile
'Obtém o valor para converter para extenso
NumeroParaConverter = rngNumeroParaConverter.Value
'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
If InStr(1, rngNumeroParaConverter.NumberFormat, "$$") > 0 Then 'Dolar
sMoedaPlu = " dólares"
sMoedaSing = " dólar"
If bSufMoeda = True Then sMoedaPlu = " de dólares"
ElseIf InStr(1, rngNumeroParaConverter.NumberFormat, "€") > 0 Then 'Euro
sMoedaPlu = " euros"
sMoedaSing = " euro"
If bSufMoeda = True Then sMoedaPlu = " de euros"
Else 'Reais
sMoedaPlu = " reais"
sMoedaSing = " real"
If bSufMoeda = True Then sMoedaPlu = " de reais"
End If
'Escreve os Centavos
sCentavos = EscreveCentavos(sDecimais)
'Adiciona a moeda e os centavos
sExtensoFinal = Application.WorksheetFunction.Trim(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 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
Espero que tenham gostado.
Um abraço e até a próxima.
Prezado Reinaldo,
Apreciei muitíssimo seu empenho nos códigos para expressar valores de moedas por extenso.
Ocorre que não consigo inserir o símbolo de Euro “€” no editor do vb para excel. Tudo o que aparece é um quadrado negro. Agradeço se puder me explicar como proceder (no Word basta Inserir Símbolo).
Aproveitando, creio que seria semelhante o processo de gerar extenso de porcentagens e temperaturas (ºC e F), por exemplo, além de números simples com até quatro casas decimais. Estou certo?
Antecipadamente fico-lhe grato por qualquer tempo que dispense na resposta a esta.
Atenciosamente,
Aro Ejari
Olá, tudo bem?
Você pode copiar o código no site e colar, mas, use a ferramenta copiar do site. Veja na figura:
Mas, você também pode usar o comando Inserir->Símbolo do Excel numa célula, copiá-lo e colar no editor VBA.
Geralmente, o comando colar apresenta caracteres desconhecidos quando a fonte não é texto puro, como o HTML usado em sites, por exemplo.
Abç