MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


3 participantes

    [Resolvido]extenso em formulario no access 2010

    avatar
    washytonn
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 295
    Registrado : 13/01/2012

    extenso - [Resolvido]extenso em formulario no access 2010 Empty extenso em formulario no access 2010

    Mensagem  washytonn 25/5/2012, 21:30

    Eu to tentando colocar o valor no formulario e ele coloca em uma caixa ao lado o valor por extenso, ja tentei esse modelos que tem no forum mas todos estão dando um erro numero 5, uso o access 2010, como faço?????

    tipo assim: tenho um campo chamado Valor, coloquei um caixa de texto chamada "valor total" para somar todos os valores "=soma([valor])" o que eu quero é que em outra caixa de texto do lado apareca por extenso o resultado da soma da caixa de texto "valor total".

    alguem pode me ajudar?????
    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 25/5/2012, 21:40

    Primeiramente amigão fique atento a utilização de palavras reservadas do access em nomes de caixas texto, campos etc..

    Isso fatalmente incidirá em erro.

    Veja os link's abaixo da minha assinatura.

    Corrija primeiramente esss detalhes.

    Cumprimentos.
    avatar
    Convidad
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidad 25/5/2012, 21:42


    Olá

    Cole a função abaixo em um módulo global.

    Na propriedade FonteDoControle do campo valor:
    ="(" & Extenso([NomeDoCampoValor]) & ")"


    Option Compare Database
    Option Explicit

    'Função para conversão de Número para seu respectivo valor em Extenso
    Function Extenso(nValor)

    If IsNull(nValor) Or nValor <= 0 Or nValor > 9999999.99 Then
    Exit Function
    End If

    Dim nContador, nTamanho As Integer
    Dim cValor, cParte, cFinal As String
    ReDim aGrupo(4), aTexto(4) As String

    ReDim aUnid(19) As String
    aUnid(1) = "Um ": aUnid(2) = "Dois ": aUnid(3) = "Três "
    aUnid(4) = "Quatro ": aUnid(5) = "Cinco ": aUnid(6) = "Seis "
    aUnid(7) = "Sete ": aUnid(Cool = "Oito ": aUnid(9) = "Nove "
    aUnid(10) = "Dez ": aUnid(11) = "Onze ": aUnid(12) = "Doze "
    aUnid(13) = "Treze ": aUnid(14) = "Quatorze ": aUnid(15) = "Quinze "
    aUnid(16) = "Dezesseis ": aUnid(17) = "Dezessete ": aUnid(18) = "Dezoito "
    aUnid(19) = "Dezenove "

    ReDim aDezena(9) As String
    aDezena(1) = "Dez ": aDezena(2) = "Vinte ": aDezena(3) = "Trinta "
    aDezena(4) = "Quarenta ": aDezena(5) = "Cinquenta "
    aDezena(6) = "Sessenta ": aDezena(7) = "Sententa ": aDezena(Cool = "Oitenta "
    aDezena(9) = "Noventa "

    ReDim aCentena(9) As String
    aCentena(1) = "Cento ": aCentena(2) = "Duzentos "
    aCentena(3) = "Trezentos ": aCentena(4) = "Quatrocentos "
    aCentena(5) = "Quinhentos ": aCentena(6) = "Seiscentos "
    aCentena(7) = "Setecentos ": aCentena(Cool = "Oitocentos "
    aCentena(9) = "Novecentos "

    cValor = Format$(nValor, "0000000000.00")
    aGrupo(1) = Mid$(cValor, 2, 3)
    aGrupo(2) = Mid$(cValor, 5, 3)
    aGrupo(3) = Mid$(cValor, 8, 3)
    aGrupo(4) = "0" + Mid$(cValor, 12, 2)

    For nContador = 1 To 4
    cParte = aGrupo(nContador)
    nTamanho = Switch(Val(cParte) < 10, 1, Val(cParte) < 100, 2, Val(cParte) < 1000, 3)
    If nTamanho = 3 Then
    If Right$(cParte, 2) <> "00" Then
    aTexto(nContador) = aTexto(nContador) + aCentena(Left(cParte, 1)) + "e "
    nTamanho = 2
    Else
    aTexto(nContador) = aTexto(nContador) + IIf(Left$(cParte, 1) = "1", "Cem ", aCentena(Left(cParte, 1)))
    End If
    End If
    If nTamanho = 2 Then
    If Val(Right(cParte, 2)) < 20 Then
    aTexto(nContador) = aTexto(nContador) + aUnid(Right(cParte, 2))
    Else
    aTexto(nContador) = aTexto(nContador) + aDezena(Mid(cParte, 2, 1))
    If Right$(cParte, 1) <> "0" Then
    aTexto(nContador) = aTexto(nContador) + "e "
    nTamanho = 1
    End If
    End If
    End If
    If nTamanho = 1 Then
    aTexto(nContador) = aTexto(nContador) + aUnid(Right(cParte, 1))
    End If
    Next

    If Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 0 And Val(aGrupo(4)) <> 0 Then
    cFinal = aTexto(4) + IIf(Val(aGrupo(4)) = 1, "Centavo", "Centavos")
    Else
    cFinal = ""
    cFinal = cFinal + IIf(Val(aGrupo(1)) <> 0, aTexto(1) + IIf(Val(aGrupo(1)) > 1, "Milhões ", "Milhão "), "")
    If Val(aGrupo(2) + aGrupo(3)) = 0 Then
    cFinal = cFinal + "de "
    Else
    cFinal = cFinal + IIf(Val(aGrupo(2)) <> 0, aTexto(2) + "Mil ", "")
    End If
    cFinal = cFinal + aTexto(3) + IIf(Val(aGrupo(1) + aGrupo(2) + aGrupo(3)) = 1, "Real ", "Reais ")
    cFinal = cFinal + IIf(Val(aGrupo(4)) <> 0, "e " + aTexto(4) + IIf(Val(aGrupo(4)) = 1, "Centavo", "Centavos"), "")
    End If
    Extenso = cFinal
    End Function

    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 25/5/2012, 21:46

    Crie um Modulo, Salve-o com o nome de BasExtenso.

    No Módulo cole:


    Option Compare Database
    Option Explicit



    Public Function Extenso97(nValor As String) As String
    'Autoria..: Eng. Cesar Costa e Dalicio Guiguer Filho
    'Linguagem: Access Basic
    'Data.....: Fevereiro/1994

    'Modificada: Wintceas Villaça Godois Jr.
    'Linguagem.: VBA
    'Data......: Outubro/1997

    'Modificada: César Rocha
    'Linguagem.: VBA
    'Data......: Novembro/1997

    'Faz a validação do argumento
    If IsNull(nValor) Or nValor > 999999999.99 Then Exit Function

    'Declara as variáveis da função
    Dim intContador As Integer
    Dim intTamanho As Integer
    Dim strValor As String
    Dim strParte As String
    Dim strFinal As String
    Dim strGrupo(4) As String
    Dim strTexto(4) As String

    'Define matrizes com extensos parciais
    Dim strUnid(19) As String
    strUnid(1) = "um ": strUnid(2) = "dois ": strUnid(3) = "três ": strUnid(4) = "quatro ": strUnid(5) = "cinco ": strUnid(6) = "seis ": strUnid(7) = "sete ": strUnid(8) = "oito ": strUnid(9) = "nove ": strUnid(10) = "dez ": strUnid(11) = "onze ": strUnid(12) = "doze ": strUnid(13) = "treze ": strUnid(14) = "quatorze ": strUnid(15) = "quinze ": strUnid(16) = "dezesseis ": strUnid(17) = "dezessete ": strUnid(18) = "dezoito ": strUnid(19) = "dezenove "
    Dim strDezena(9) As String
    strDezena(1) = "dez ": strDezena(2) = "vinte ": strDezena(3) = "trinta ": strDezena(4) = "quarenta ": strDezena(5) = "cinqüenta ": strDezena(6) = "sessenta ": strDezena(7) = "setenta ": strDezena(8) = "oitenta ": strDezena(9) = "noventa "
    Dim strCentena(9) As String
    strCentena(1) = "cento ": strCentena(2) = "duzentos ": strCentena(3) = "trezentos ": strCentena(4) = "quatrocentos ": strCentena(5) = "quinhentos ": strCentena(6) = "seiscentos ": strCentena(7) = "setecentos ": strCentena(8) = "oitocentos ": strCentena(9) = "novecentos "

    'Divide o valor em vários grupos
    strValor = Format$(nValor, "0000000000.00")
    strGrupo(1) = Mid$(strValor, 2, 3) 'Milhão
    strGrupo(2) = Mid$(strValor, 5, 3) 'Milhar
    strGrupo(3) = Mid$(strValor, 8, 3) 'Centena
    strGrupo(4) = "0" + Mid$(strValor, 12, 2) 'Centavo

    'Processa cada grupo
    For intContador = 1 To 4
    strParte = strGrupo(intContador)

    intTamanho = Switch(Val(strParte) < 10, 1, Val(strParte) < 100, 2, Val(strParte) < 1000, 3)
    If intTamanho = 3 Then
    If Right$(strParte, 2) <> "00" Then
    strTexto(intContador) = strTexto(intContador) + strCentena(Left(strParte, 1)) + "e "
    intTamanho = 2
    Else
    strTexto(intContador) = strTexto(intContador) + IIf(Left$(strParte, 1) = "1", "cem ", strCentena(Left(strParte, 1)))
    End If
    End If

    If intTamanho = 2 Then
    If Val(Right(strParte, 2)) < 20 Then
    strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 2))
    Else
    strTexto(intContador) = strTexto(intContador) + strDezena(Mid(strParte, 2, 1))
    If Right$(strParte, 1) <> "0" Then
    strTexto(intContador) = strTexto(intContador) + "e "
    intTamanho = 1
    End If
    End If
    End If

    If intTamanho = 1 Then
    strTexto(intContador) = strTexto(intContador) + strUnid(Right(strParte, 1))
    End If
    Next intContador

    'Gera o formato final do texto
    If Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
    strFinal = strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos")
    Else
    strFinal = ""
    If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
    End If
    If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
    End If
    If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões e ", "milhão e "), "")
    End If
    If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
    End If
    If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
    End If
    If Val(strGrupo(2)) <> 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
    End If
    If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) = 0 And Val(strGrupo(4)) <> 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões de ", "milhão de "), "")
    End If
    If Val(strGrupo(2)) = 0 And Val(strGrupo(3)) <> 0 And Val(strGrupo(4)) <> 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(1)) <> 0, strTexto(1) + IIf(Val(strGrupo(1)) > 1, "milhões, ", "milhão, "), "")
    End If
    If Val(strGrupo(3)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil ", "")
    Else
    If Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil e ", "")
    Else
    strFinal = strFinal + IIf(Val(strGrupo(2)) <> 0, strTexto(2) + "mil, ", "")
    End If
    End If
    If Val(strGrupo(4)) = 0 Then
    strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais ")
    Else
    strFinal = strFinal + strTexto(3) + IIf(Val(strGrupo(3)) <> 1, IIf(Val(strGrupo(1) + strGrupo(2) + strGrupo(3)) = 1, "real ", "reais "), "real ")
    End If
    strFinal = strFinal + IIf(Val(strGrupo(4)) <> 0, "e " + strTexto(4) + IIf(Val(strGrupo(4)) = 1, "centavo", "centavos"), "")
    End If
    If Left(strFinal, 1) = "u" Then
    Extenso97 = "H" & Mid$(strFinal, 1)
    Else
    Extenso97 = UCase(Mid$(strFinal, 1, 1)) & Mid$(strFinal, 2)
    End If
    Dim aux As String * 250
    aux = Trim(Extenso97) ' e alterar esta linha para trim(Extenso)
    While Len(Trim(aux)) <> 250
    aux = Trim(aux) & "-x"
    Wend
    Extenso97 = aux

    End Function




    Na consulta utilize em um campo não acoplado:

    Extenso: Extenso97([CpValor])

    Cumprimentos.


    Última edição por Harysohn em 25/5/2012, 21:57, editado 1 vez(es)
    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 25/5/2012, 21:47

    Opa Mestre... não percebi que estavas a responder.

    Cumprimentos.
    avatar
    washytonn
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 295
    Registrado : 13/01/2012

    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  washytonn 28/5/2012, 14:57

    Deu certo ... valeu... obrigado....
    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 28/5/2012, 15:34

    O Fórum agradece o retorno.
    *** Não se esqueça de clicar no joinha da mensagem que o auxiliou.
    avatar
    washytonn
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 295
    Registrado : 13/01/2012

    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  washytonn 28/5/2012, 16:09

    Harysohn...
    que mau pergunte que joinha é esse???
    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 28/5/2012, 16:51

    Em cada mensagem das pessoas que lhe auxiliam, do lado tem uma maozinha.... Na mensagem que lhe serviu.. clique nela.
    avatar
    washytonn
    Avançado
    Avançado


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 295
    Registrado : 13/01/2012

    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  washytonn 28/5/2012, 16:58

    Beleza. obrigado.
    avatar
    Israel
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 6
    Registrado : 17/09/2012

    extenso - [Resolvido]extenso em formulario no access 2010 Empty Extenso

    Mensagem  Israel 19/9/2012, 21:13

    Jé tentei todas as opções indicadas mas até agora n~]ao consegui

    Criei um recibo em formulário, e quero que num campo não acoplado apareça por extenso o valor numérico digitado em um outro campo

    ainda não consegui

    Por favor alguém pode me ajudar passo a passo
    avatar
    Convidado
    Convidado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Convidado 20/9/2012, 03:53

    A solução são estas apresentadas... Caso não consiga, poste o BD para que vejamos pra ti.

    Cumprimentos.
    avatar
    ktm
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3
    Registrado : 04/06/2013

    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  ktm 4/6/2013, 15:59

    Convidado

    o modulo Extenso criado quando executo o relatório pede o valor, se eu informo, como resultado o campo do relatório resulta em #Erro.

    Conteúdo patrocinado


    extenso - [Resolvido]extenso em formulario no access 2010 Empty Re: [Resolvido]extenso em formulario no access 2010

    Mensagem  Conteúdo patrocinado


      Data/hora atual: 23/11/2024, 14:06