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


2 participantes

    [Resolvido]valor por extenso em relatorio

    avatar
    itamargomes
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 14
    Registrado : 27/12/2015

    extenso - [Resolvido]valor por extenso em relatorio Empty [Resolvido]valor por extenso em relatorio

    Mensagem  itamargomes 21/12/2022, 02:09

    Ola pessoal, alguem pode mima judar a resolver o problema desse codigo:

    o valor por extenso quando é um valor inteiro, por exemploe 1220,00, sai um mil duzentos e vinte e cem centavos.


    Public Function Extenso(ByVal Valor As _
    Double, ByVal MoedaPlural As _
    String, ByVal MoedaSingular As _
    String) As String
    Dim strValor As String, Negativo As Boolean
    Dim Buf As String, Parcial As Integer
    Dim Posicao As Integer, Unidades
    Dim Dezenas, Centenas, PotenciasSingular
    Dim PotenciasPlural

    Negativo = (Valor < 0)
    Valor = Abs(CDec(Valor))
    If Valor Then
    Unidades = Array(vbNullString, "Um", "Dois", _
    "Três", "Quatro", "Cinco", _
    "Seis", "Sete", "Oito", "Nove", _
    "Dez", "Onze", "Doze", "Treze", _
    "Quatorze", "Quinze", "Dezesseis", _
    "Dezessete", "Dezoito", "Dezenove")
    Dezenas = Array(vbNullString, vbNullString, _
    "Vinte", "Trinta", "Quarenta", _
    "Cinqüenta", "Sessenta", "Setenta", _
    "Oitenta", "Noventa")
    Centenas = Array(vbNullString, "Cento", _
    "Duzentos", "Trezentos", _
    "Quatrocentos", "Quinhentos", _
    "Seiscentos", "Setecentos", _
    "Oitocentos", "Novecentos")
    PotenciasSingular = Array(vbNullString, " Mil", _
    " Milhão", " Bilhão", _
    " Trilhão", " Quatrilhão")
    PotenciasPlural = Array(vbNullString, " Mil", _
    " Milhões", " Bilhões", _
    " Trilhões", " Quatrilhões")

    strValor = Left(Format(Valor, String(18, "0") & _
    ".000"), 18)
    For Posicao = 1 To 18 Step 3
    Parcial = Val(Mid(strValor, Posicao, 3))
    If Parcial Then
    If Parcial = 1 Then
    Buf = "Um" & PotenciasSingular((18 - _
    Posicao) \ 3)
    ElseIf Parcial = 100 Then
    Buf = "Cem" & PotenciasSingular((18 - _
    Posicao) \ 3)
    Else
    Buf = Centenas(Parcial \ 100)
    Parcial = Parcial Mod 100
    If Parcial <> 0 And Buf <> vbNullString Then
    Buf = Buf & " e "
    End If
    If Parcial < 20 Then
    Buf = Buf & Unidades(Parcial)
    Else
    Buf = Buf & Dezenas(Parcial \ 10)
    Parcial = Parcial Mod 10
    If Parcial <> 0 And Buf <> vbNullString Then
    Buf = Buf & " e "
    End If
    Buf = Buf & Unidades(Parcial)
    End If
    Buf = Buf & PotenciasPlural((18 - Posicao) \ 3)
    End If
    If Buf <> vbNullString Then
    If Extenso <> vbNullString Then
    Parcial = Val(Mid(strValor, Posicao, 3))
    If Posicao = 16 And (Parcial < 100 Or _
    (Parcial Mod 100) = 0) Then
    Extenso = Extenso & " e "
    Else
    Extenso = Extenso & ", "
    End If
    End If
    Extenso = Extenso & Buf
    End If
    End If
    Next
    If Extenso <> vbNullString Then
    If Negativo Then
    Extenso = "Menos " & Extenso
    End If
    If Int(Valor) = 1 Then
    Extenso = Extenso & " " & MoedaSingular
    Else
    Extenso = Extenso & " " & MoedaPlural
    End If
    End If
    Parcial = Int((Valor - Int(Valor)) * _
    100 + 0.1)
    If Parcial Then
    Buf = Extenso(Parcial, "Centavos", _
    "Centavo")
    If Extenso <> vbNullString Then
    Extenso = Extenso & " e "
    End If
    Extenso = Extenso & Buf
    End If
    End If
    End Function

    JPaulo
    JPaulo
    Moderador
    Moderador


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 11026
    Registrado : 04/11/2009

    extenso - [Resolvido]valor por extenso em relatorio Empty Re: [Resolvido]valor por extenso em relatorio

    Mensagem  JPaulo 21/12/2022, 14:26

    Fazendo dois testes aqui, parece-me correto;

    extenso - [Resolvido]valor por extenso em relatorio 00112


    extenso - [Resolvido]valor por extenso em relatorio 00212


    .................................................................................
    Contribua com o maximoaccess nos links abaixo, ajude a melhorar este que é o seu site na NET.

    Pay-Pal R$ Aqui
    Pay-Pal € Aqui

    Ou ainda: Aqui (Novo)

    Sucesso e Bons Estudos
    Success and Good Studies

    extenso - [Resolvido]valor por extenso em relatorio Folder_announce_new Utilize o Sistema de Busca do Fórum...
    extenso - [Resolvido]valor por extenso em relatorio Folder_announce_new 102 Códigos VBA Gratuitos...
    extenso - [Resolvido]valor por extenso em relatorio Folder_announce_new Instruções SQL como utilizar...
    avatar
    itamargomes
    Novato
    Novato


    Respeito às regras : Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 14
    Registrado : 27/12/2015

    extenso - [Resolvido]valor por extenso em relatorio Empty Re: [Resolvido]valor por extenso em relatorio

    Mensagem  itamargomes 22/12/2022, 00:17

    é incrivel, não entendi porque gerei um relatorio e de diferente,
    achei o probelma, é que o valor tava uma dizima, e aparecia arrededondado.
    Anexos
    extenso - [Resolvido]valor por extenso em relatorio AttachmentREL-30-8-Termo_de_recebimento.pdf
    Você não tem permissão para fazer download dos arquivos anexados.
    (130 Kb) Baixado 28 vez(es)

    Conteúdo patrocinado


    extenso - [Resolvido]valor por extenso em relatorio Empty Re: [Resolvido]valor por extenso em relatorio

    Mensagem  Conteúdo patrocinado


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