Não tem coisa melhor do que a comunidade. A troca de informações gera mais informação, que por fim, acaba resultando em ajuda para muita gente, sem sequer percebermos.
O colega João Henrique Botelho de Amorim encontrou neste site a função em VBA que possibilitava escrever números por extenso. Utilizando-a, descobriu alguns bugs e melhorias, decidindo compartilhar conosco tais mudanças. Abaixo segue a versão disponibilizada pelo colega:
Public Function PorExtenso(ByVal n As Double) As String ' Excel VBA - Write numbers in full - Escrever números por extenso ' Macro adaptada, corrigida e comentada em 10/01/2011 por João Henrique Amorim ' E-mail: jhbamorim@yahoo.com ' Fonte: http://www.tomasvasquez.com.br/ ' Alguns problemas solucionados: '-Problema com quatrocentos, seiscentos, setecentos (tudo que tenha "centos" no nome). "401" era escrito: "quatrocento e s um" '-Espaço duplo sempre após ocorrência de "e": "um mil e um"; "quinhentos e um" '-Falta um "e" em 1200, 1300, 1400,...2200,.... Escrevia: "dois mil duzentos" '-Não escreve números maiores que 10.000 (10.005 é escrito como "cinco"). Já que isso não é um problema no meu caso, bastou usar um if inicial para impedir números maiores que esse. Dim num As Double, Unid As Variant, Dezen As Variant, Centen As Variant Unid = Array("", "um", "dois", "três", "quatro", "cinco", _ "seis", "sete", "oito", "nove", "dez", "onze", "doze", _ "treze", "quatorze", "quinze", "dezesseis", "dezessete", _ "dezoito", "dezenove", "vinte") Dezen = Array("", "dez", "vinte", "trinta", "quarenta", _ "cinquenta", "sessenta", "setenta", "oitenta", "noventa") Centen = Array("", "cento", "duzentos", "trezentos", _ "quatrocentos", "quinhentos", "seiscentos", _ "setecentos", "oitocentos", "novecentos", "mil") 'Essa função não escreve números maiores que 9.999 If n > 9999 Then PorExtenso = "Número deve ser menor que 10.000": Exit Function num = n PorExtenso = "" If n = 0 Then PorExtenso = "zero" End If If (n \ 1000) > 0 And n \ 1000 < 10 Then 'O número possui milhares? PorExtenso = Unid(n \ 1000) & " mil " 'Então escreve a unidade seguida da palavra mil End If n = n - (n \ 1000) * 1000 'Agora n vai apenas até as centenas do número If n > 100 Then 'Possui centenas? PorExtenso = PorExtenso & Centen(n \ 100) 'Junta-as ao final da frase End If If n = 100 Then PorExtenso = PorExtenso & " cem" 'Se for 100 apenas junta "cem" ao final da frase GoTo Prossiga 'E vai para a concatenaçao final das coisas na string End If n = n - (n \ 100) * 100 'Agora pega apenas ate as dezenas. If n >= 20 And n < 100 Then 'Se as dezenas estiverem entre 20 e 99 junte-as ao fim da frase PorExtenso = PorExtenso & " " & Dezen(n \ 10) End If If n > 0 And n < 20 Then 'Entre 1 e 19 escreve a unidade no fim da frase PorExtenso = PorExtenso & " " & Unid(n) GoTo Prossiga 'E vai para a concatenaçao final das coisas na string End If n = n - (n \ 10) * 10 'Pega só a unidade If n > 0 Then 'Junta o nome da unidade ao fim da frase, PorExtenso = PorExtenso & " " & Unid(n) End If 'na qual ja deve constar os milhares e dezenas SE houver... Prossiga: If num Mod 10 <> 0 Then If InStr(1, PorExtenso, "vinte", 1) = 0 Then If InStr(1, PorExtenso, "trinta", 1) = 0 Then If InStr(1, PorExtenso, "enta", 1) > 0 Then 'Sempre lembrando de suprimir todos os espaços após o "e" PorExtenso = Application.Substitute(PorExtenso, "enta", "enta e") End If End If End If End If If num Mod 10 <> 0 Then If InStr(1, PorExtenso, "vinte", 1) > 0 Then If InStr(1, PorExtenso, "trinta", 1) = 0 Then If InStr(1, PorExtenso, "enta", 1) = 0 Then PorExtenso = Application.Substitute(PorExtenso, "vinte", "vinte e") End If End If End If End If If num Mod 10 <> 0 Then If InStr(1, PorExtenso, "vinte", 1) = 0 Then If InStr(1, PorExtenso, "trinta", 1) > 0 Then If InStr(1, PorExtenso, "enta", 1) = 0 Then PorExtenso = Application.Substitute(PorExtenso, "trinta", "trinta e") End If End If End If End If 'Troca-se de "cento" para "cento e" apenas se o nome NAO contiver "centos" para não destruir quatroCentos, seisCentos...etc If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) <= 0 Then If InStr(1, PorExtenso, "ento", 1) > 0 Then PorExtenso = Application.Substitute(PorExtenso, "cento", "cento e") End If End If 'Troca-se de "entos" para "entos e" apenas se o nome NAO contiver "centos" para não destruir quatroCentos, seisCentos...etc If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) <= 0 Then 'Aqui mora o problema! If InStr(1, PorExtenso, "entos", 1) > 0 Then PorExtenso = Application.Substitute(PorExtenso, "entos", "entos e") End If End If 'Agora que os "entos" já foram resolvidos, resolvamos os centos de quatrocentos, seiscentos, etc If num Mod 100 <> 0 And InStr(1, PorExtenso, "centos", 1) > 0 Then If InStr(1, PorExtenso, "centos", 1) > 0 Then PorExtenso = Application.Substitute(PorExtenso, "centos", "centos e") End If End If 'E continua testando os milhares...Tendo agora o cuidado de procurar pelo espaço após o "mil" para que ele não fique duplicado If num Mod 1000 <> 0 Then 'A troca de "mil" por "mil e" está ocorrendo quando após o milhar vier número de 1 a 99 If (num - (num \ 1000) * 1000) <= 100 Then If InStr(1, PorExtenso, "mil ", 1) > 0 Then PorExtenso = Application.Substitute(PorExtenso, "mil ", "mil e") End If End If 'Mas a troca de "mil" por "mil e" também deve ocorrer quando após o milhar vier 200, 300,...,900. Mas não 100! Pois foi tratado no if anterior. If (num - (num \ 100) * 100) = 0 And (num - (num \ 1000) * 1000) <> 100 Then If InStr(1, PorExtenso, "mil ", 1) > 0 Then PorExtenso = Application.Substitute(PorExtenso, "mil ", "mil e ") End If End If End If End Function |
De quebra, ainda acrescentou vários comentários úteis para o entendimento do código. Valeu João!
Abraços a todos