Tag Archives: Extenso

VBA – Escrevendo números por extenso – Parte 2

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

Excel VBA – Escrevendo números por extenso

Usando-se o Excel / VBA seria possível escrever-se uma função que após ler um numero na forma tradicional, o converta para forma “por extenso” ? Essa função em outras palavras, deverá ser capaz de ler um valor qualquer inteiro e escreve-lo por extenso (ex:”Quatro Mil Duzentos e Quinze”). Isso é possível ? Ficamos gratos pelo Help.

Public Function EscrevePorExtenso(ByVal n As Double) As String
    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")
    Num = n
    Escr = ""
    If n = 0 Then
        Escr = "Zero"
    End If
    If (n \ 1000) &gt; 0 And n \ 1000 &lt; 10 Then         Escr = Unid(n \ 1000) &amp; " Mil "     End If     n = n - (n \ 1000) * 1000     If n &gt; 100 Then
        Escr = Escr &amp; Centen(n \ 100)
    End If
    If n = 100 Then
        Escr = Escr &amp; " Cem"
        GoTo Prossiga
    End If
    n = n - (n \ 100) * 100
    If n &gt;= 20 And n &lt; 100 Then         Escr = Escr &amp; " " &amp; Dezen(n \ 10)     End If     If n &gt; 0 And n &lt; 20 Then         Escr = Escr &amp; " " &amp; Unid(n)         GoTo Prossiga     End If     n = n - (n \ 10) * 10     If n &gt; 0 Then
        Escr = Escr &amp; " " &amp; Unid(n)
    End If
Prossiga:
    If Num Mod 10 &lt;&gt; 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) &gt; 0 Then
                    Escr = Application.Substitute(Escr, "enta", "enta e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 &lt;&gt; 0 Then
        If InStr(1, Escr, "Vinte", 1) &gt; 0 Then
            If InStr(1, Escr, "Trinta", 1) = 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Vinte", "Vinte e ")
                End If
            End If
        End If
    End If
    If Num Mod 10 &lt;&gt; 0 Then
        If InStr(1, Escr, "Vinte", 1) = 0 Then
            If InStr(1, Escr, "Trinta", 1) &gt; 0 Then
                If InStr(1, Escr, "enta", 1) = 0 Then
                    Escr = Application.Substitute(Escr, "Trinta", "Trinta e ")
                End If
            End If
        End If
    End If
    If Num Mod 100 &lt;&gt; 0 Then
        If InStr(1, Escr, "ento", 1) &gt; 0 Then
            Escr = Application.Substitute(Escr, "Cento", "Cento e ")
        End If
    End If
    If Num Mod 100 &lt;&gt; 0 Then
        If InStr(1, Escr, "entos", 1) &gt; 0 Then
            Escr = Application.Substitute(Escr, "entos", "entos e ")
        End If
    End If
    If Num Mod 1000 &lt;&gt; 0 Then
        If (Num - (Num \ 1000) * 1000) &lt;= 100 Then             If InStr(1, Escr, "Mil", 1) &gt; 0 Then
                Escr = Application.Substitute(Escr, "Mil", "Mil e ")
            End If
        End If
    End If
End Function

A função suporta números até 9999. Não é muito, mas já quebra um galho.

Bom proveito!

Fonte: BestExcel

Tomás Vásquez
www.tomasvasquez.com.br