none
Valor por extenso em um campo do formulário MS Word 2007 RRS feed

  • Pergunta

  • Olá a todos.

    To com um probema que já fucei a net toda e não achei a solução, seguinte; Tenho um formulário no MS Word 2007 que o usuário preeche com valores em R$, gostaria que esse valor fosse escrito por extenso logo do lado exemplo R$ 2,00 (Dois Reais).

    Obrigado desde já.

    quarta-feira, 18 de maio de 2011 19:09

Respostas

  • Use algo como:

    Sub fConverter()
        If IsNumeric(Selection) Then Selection.TypeText Selection & " (" & Extenso(Selection) & ")"
    End Sub
    
    Private 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, 27 de junho de 2013 22:42
    Moderador

Todas as Respostas

  • Olá,

    Creio que esta rotina te ajudará: http://www.wordpower.com.br/home/blog-ms-office-gurus/valor-por-extenso-no-excel.html


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br
    sexta-feira, 20 de maio de 2011 14:22
    Moderador
  • Eu também estou com a mesma questão.

    O link indicado não existe mais.

    quinta-feira, 27 de junho de 2013 01:33
  • Use algo como:

    Sub fConverter()
        If IsNumeric(Selection) Then Selection.TypeText Selection & " (" & Extenso(Selection) & ")"
    End Sub
    
    Private 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, 27 de junho de 2013 22:42
    Moderador
  • Olá, Boa noite!

    Obrigado pela resposta, ajudou-me bastante, porém eu ainda não consegui atingir completamente meu objetivo.

    A macro funciona, mas quando o documento está sem a proteção (preenchendo formulários).

    Quando ativada a proteção do documento, eu consigo preencher os campos do formulário, só que ao sair do campo do valor, a macro não executa.

    Para você entender melhor o que eu pretendo: Eu criei um contrato, com um texto protegido (modo preenchendo formulários) onde são editáveis apenas o campo de formulário "nome1", "data", "Vvalor", "nome2" da linha de assinatura". Consegui fazer funcionar a macro que faz repetir o que for digitado no campo "nome1" no campo "nome2" da linha de assinatura."

    A minha dificuldade (e meu objetivo) é fazer funcionar a macro de preencher o número por extenso no campo "Vvalor", logo após que eu abandonar este campo para o outro. 

    Percebo que para eu atingir este objetivo, falta algum código de instrução na fórmula ou uma linha.

    Peço ajuda mais uma vez.

    Agradeço-lhe imensamente

    sexta-feira, 28 de junho de 2013 02:56
  • Se você desabilitar temporariamente a proteção por formulários do seu documento e, ao término da execução, voltar a proteção, adianta?

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

    sexta-feira, 28 de junho de 2013 21:28
    Moderador
  • Olá! 

    Desculpe a demora pra resposta,  eu havia perdido o link deste tópico de ajuda e agora que pude retomar o projeto.

    Eu consegui fazer funcionar, apenas em um momento. Mesmo assim, achei o procedimento um pouco trabalhoso, tendo em vista que um estagiário poderá se atrapalhar e prejudicar a sua produtividade.

    Existe uma forma de programar  de modo que ele execute  a marco quando abandonar o campo?

    Eu consegui uma macro que repete o texto digitado no campo1, no campo2, campo3 (ou quantos forem programados) quando este é abandonado.

    Eis o código:

    Sub RepeteTexto()
       ' Copia o texto de Nome1 e repete-o em Nome2 '
       Dim strValor As String
       strValor = ActiveDocument.FormFields("Texto1").Result
       ActiveDocument.FormFields("Texto2").Result = strValor
       ActiveDocument.FormFields("Texto3").Result = strValor
       ActiveDocument.FormFields("Texto4").Result = strValor
          
    End Sub

    Seria possível adaptar o código "por extenso" de modo que a macro seja executada com a proteção do documento ativa e ao abandonar o campo de digitação?

    Obrigado, mais uma vez.

    Um abraço

     

    quarta-feira, 31 de julho de 2013 00:37
  • Está difícil eu montar um exemplo parecido com o seu. Poderia disponibilizar seu Documento para download para eu sugerir um código?

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

    sábado, 3 de agosto de 2013 00:38
    Moderador