none
Macro para preecher campos e colocar valores por extenso RRS feed

  • Pergunta

  • Caros,

    Preciso de uma macro que peça vários campos em popup, e em alguns os valores informados tem logo após o valor por extenso.

    Obrigado.


    The mind is the Universe Portal

    terça-feira, 9 de abril de 2013 04:24

Respostas

  • Achei o primeiro campo que você se referiu desnecessário.

    Utilize o código abaixo e execute o subprocedimento fMain:

    Sub fMain()
        Dim str As String
            
        str = InputBox("Digite o valor do número")
        If Not IsNumeric(str) Or str = "" Then Exit Sub
        If str < 0 Then Exit Sub
        
        Selection.TypeText Format(str, "R$ #,##0.00") _
        & " (" & Extenso(CDbl(str)) & ")"
    End Sub
    
    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


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 30 de maio de 2013 20:14
    Moderador

Todas as Respostas

  • Olá Kris, bom dia.

    Estou migrando seu thread para o fórum especializado em VBA.


    Obrigado por contactar o fórum Microsoft Technet!

    quinta-feira, 11 de abril de 2013 10:27
    Moderador
  • No link abaixo há uma função que transforma números para extenso: http://www.ambienteoffice.com.br/officevba/valor_em_extenso/

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 13 de abril de 2013 21:21
    Moderador
  • Obrigado pela atenção

    Gostei muito desta solução, mas preciso que ela pegue o valor já digitado no documento e seja executada por um botão


    The mind is the Universe Portal

    quarta-feira, 8 de maio de 2013 21:57
  • Crie um botão na planilha e atribua o mesmo à uma macro, sabe como fazer?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 8 de maio de 2013 23:50
    Moderador
  • Se não me engano esta macro so pede entrada via caixa de texto, não eh isso que necessito.

    The mind is the Universe Portal

    quinta-feira, 9 de maio de 2013 05:21
  • Qual é a aplicação que está usando? Word? Excel?

    O que você precisa que a rotina faça? Busque os números e troque-os por seu valor extenso? Detalhe.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 9 de maio de 2013 22:10
    Moderador
  • Obrigado pela atenção.

    A aplicação e o word.

    Necessito que quando um documento for aberto, que seja pedido em caixa de dialogo que seja informado valores

    para determinados campos e em um o valor em extenso.


    The mind is the Universe Portal

    quarta-feira, 15 de maio de 2013 15:06
  • Por exemplo: você digitará o valor 5, então a rotina buscará todos os 5 do documento e transformará em cinco?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 20 de maio de 2013 22:04
    Moderador
  • Obrigado pela atenção.

    Necessito fazer o seguinte:

    que seja necessário informar valores em dois campos, um deles eh uma numeração, o outro um valor. necessito que a macro escreva o valor por extenso deste segundo campo logo apos este.

    Ex.  R$ [5000,00] ai ficará R$ 5.000,00 (Cinco mil Reais) no documento. Ou seja será informado no campo o valor sem sem dezenas, centenas , milhares e somente o separador de centavos. mas aparecera no docunto "R$ 5.000,00 (Cinco mil Reais)".

    Mais uma vez obrigado pela atenção.


    The mind is the Universe Portal

    quinta-feira, 30 de maio de 2013 15:21
  • Achei o primeiro campo que você se referiu desnecessário.

    Utilize o código abaixo e execute o subprocedimento fMain:

    Sub fMain()
        Dim str As String
            
        str = InputBox("Digite o valor do número")
        If Not IsNumeric(str) Or str = "" Then Exit Sub
        If str < 0 Then Exit Sub
        
        Selection.TypeText Format(str, "R$ #,##0.00") _
        & " (" & Extenso(CDbl(str)) & ")"
    End Sub
    
    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


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 30 de maio de 2013 20:14
    Moderador
  • Muito bom, agradecido

    Mas eu ainda preciso de mais uma ajuda.

    Como faço para executar a macro automaticamente quando eu me mover para um campo?

    Obrigado


    The mind is the Universe Portal

    sexta-feira, 7 de junho de 2013 05:17
  • Quando diz campo, você está se referindo à um campo Word (cria-se um campo pressionando Ctrl+F9) ou outra coisa?

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    sábado, 8 de junho de 2013 01:25
    Moderador