MaximoAccess

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

Obrigado

Administração do MaximoAccess

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

    Arredondamento NFe

    elpauli
    elpauli
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 19
    Registrado : 10/08/2016

    Arredondamento NFe Empty Arredondamento NFe

    Mensagem  elpauli em 21/7/2018, 11:01

    '//Padrão de Arredondamento de casas decimais para Nfe. - função Disponível na NET
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    'FUNÇÃO PARA FAZER O ARREDONDAMENTO DE VALORES, BASEADO NAS REGRAS DE ARREDONDAMENTO DA NORMA ABNT NBR 5891 DE 1977
    'TRABALHA COM 4 DIGITOS NA DECIMAL DE ENTRADA
    'DEVOLVERÁ O VALOR ARREDONDADO COM 2 DECIMAIS
    '////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
    Public Function Arred_NBR5891(VALOR As Currency) As Currency
    On Error GoTo Trata_Erros


    'TRANSFORMA E FORMATA O VALOR PARA STRING E 4 DECIMAIS
    Dim StrValor_Trabalhar As String
    StrValor_Trabalhar = Format(VALOR, "############0.0000")

    'DESCOBRE A POSIÇÃO DA VIRGULA
    Dim Posicao_Virgula As Integer
    Posicao_Virgula = InStr(1, CStr(StrValor_Trabalhar), ",")
    Dim StrDecimal As String
    StrDecimal = Mid(StrValor_Trabalhar, Posicao_Virgula + 1, Len(StrValor_Trabalhar))

    'VERIFICA SE NA DECIMAL OS 2 ULTIMOS DIGITOS SÃO IGUAIS A "00", SE FOREM, NÃO SERÁ NECESSÁRIO ARREDONDAR
    'POR EXEMPLO 2,5500
    If Mid(StrDecimal, 3, 2) = "00" Then
    Arred_NBR5891 = Format(CCur(StrValor_Trabalhar), "############0.00")
    Exit Function
    End If


    'DEFAULT
    Dim StrValor_Retornar As String
    StrValor_Retornar = CStr(Format(VALOR, "#############0.00"))


    '********************************************************************************************************************************************
    '1- Quando o algarismo seguinte a 2ª CASA for INFERIOR a 5, A 2ª CASA permanecerá SEM modificação.
    'ENTÃO SE NA 3ª CASA O NUMERO FOR < 5 (MENOR QUE 5) ENTÃO NÃO ARREDONDA, MANTEM O VALOR ORIGINAL
    'EXEMPLO 2,5501 FICARÁ SOMENTE 2,55 POIS A TERCEIRA CASA (0) É MENOR QUE 5
    '********************************************************************************************************************************************
    If CInt(Mid(StrDecimal, 3, 1)) < 5 Then
    StrValor_Retornar = Mid(StrValor_Trabalhar, 1, Len(StrValor_Trabalhar) - 2) 'PEGA O VALOR SEM AS 2 ULTIMAS CASAS, EX: 2,5501 REMOVERÁ O 01 DO FINAL, RETORNANDO SOMENTE O 2,55
    Arred_NBR5891 = Format(StrValor_Retornar, "############0.00")
    Exit Function

    End If

    '********************************************************************************************************************************************
    '2 - Quando o algarismo seguinte A 2ª CASA for SUPERIOR a 5 ENTÃO AUMENTARA EM UMA UNIDADE A 2ª CASA, EXEMPLO: 2,556 (FICA 2,56)
    '********************************************************************************************************************************************

    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    'VERIFICA SE A TERCEIRA CASA É MAIOR QUE 5
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    If CInt(Mid(StrDecimal, 3, 1)) > 5 Then
    'SE FOR MAIOR QUE 5, ENTÃO ARREDONDA PRA MAIS O VALOR, EXEMPLO: 2,556 FICARÁ 2,56
    StrValor_Retornar = Mid(StrValor_Trabalhar, 1, Len(StrValor_Trabalhar) - 2) 'PEGA O VALOR SEM AS 2 ULTIMAS CASAS, EX: 2,5501 REMOVERÁ O 01 DO FINAL, RETORNANDO SOMENTE O 2,55
    StrValor_Retornar = CCur(StrValor_Retornar) + CCur("0,01")
    Arred_NBR5891 = Format(StrValor_Retornar, "############0.00")
    Exit Function
    End If


    '************************************************************************************************************************************************************************
    '3 - Quando a TERCEIRA CASA É IGUAL A CINCO, TEREMOS 2 OPCOES (A e B):
    '************************************************************************************************************************************************************************

    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '(A) - SE A SEGUNDA CASA FOR IMPAR ENTÃO ARREDONDA PRA MAIS O VALOR, EXEMPLO: 2,3751 (o 7 dos 37 centavos é IMPAR, neste caso arredonda pra mais)
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    If EImpar(CLng(Mid(StrDecimal, 2, 1))) = True Then
    StrValor_Retornar = Mid(StrValor_Trabalhar, 1, Len(StrValor_Trabalhar) - 2) 'PEGA O VALOR SEM AS 2 ULTIMAS CASAS, EX: 2,3751 REMOVERÁ O 51 DO FINAL, RETORNANDO SOMENTE O 2,37
    StrValor_Retornar = CCur(StrValor_Retornar) + CCur("0,01")
    Arred_NBR5891 = Format(StrValor_Retornar, "############0.00")
    Exit Function
    End If

    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    '(B) - SE A SEGUNDA CASA FOR PAR, ENTÃO:
    'SE A QUARTA CASA FOR ALGARISMO ZERO, NÃO HAVERÁ ALTERAÇÃO NAS DECIMAIS, RETORNANDO O VALOR SEM ARREDONDAR, EXEMPLO: 2,5450 (FICARA 2,54)
    'SE A QUARTA CASA FOR ALGARISMO DIFERENTE DE ZERO, A 2ª CASA deverá ser AUMENTADA EM UMA unidade, EXEMPLO: 2,5451 (FICARÁ 2,55)
    '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

    'SE A QUARTA CASA FOR IGUAL A ZERO
    If CInt(Mid(StrDecimal, 4, 1)) = 0 Then
    StrValor_Retornar = Mid(StrValor_Trabalhar, 1, Len(StrValor_Trabalhar) - 2) 'PEGA O VALOR SEM AS 2 ULTIMAS CASAS, EX: 2,5450 REMOVERÁ O 50 DO FINAL, RETORNANDO SOMENTE O 2,54
    Arred_NBR5891 = Format(StrValor_Retornar, "############0.00")
    Exit Function

    'SE A QUARTA CASA FOR MAIOR QUE ZERO, ACRESCENTA EM 0,01 ARREDONDANDO PRA MAIS O VALOR DECIMAL COM 2 CASAS
    Else
    StrValor_Retornar = Mid(StrValor_Trabalhar, 1, Len(StrValor_Trabalhar) - 2) 'PEGA O VALOR SEM AS 2 ULTIMAS CASAS, EX: 2,3451 REMOVERÁ O 51 DO FINAL, RETORNANDO SOMENTE O 2,34
    StrValor_Retornar = CCur(StrValor_Retornar) + CCur("0,01") 'SOMA MAIS 1 CENTAVO
    Arred_NBR5891 = Format(StrValor_Retornar, "############0.00")
    Exit Function
    End If


    Trata_Erros:
    If Err.Number <> 0 Then
    MsgBox "Erro na funcao de ARREDONDAMENTO ABNT NBR 5891: " & Err.Source & " " & Err.Description, vbCritical, strApp
    Exit Function
    End If
    End Function


    Function EImpar(ByVal iNum As Long) As Boolean
    'Verifica se o número é impar
    'Se for impar a função retorna True.
    'Se for par a função retorna False.
    EImpar = (iNum Mod 2)
    End Function
    ahteixeira
    ahteixeira
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6954
    Registrado : 15/03/2013

    Arredondamento NFe Empty Re: Arredondamento NFe

    Mensagem  ahteixeira em 21/7/2018, 11:54

    Olá Elcio Pauli,

    Parabéns, obrigado pela partilha, o fórum agradece.

    Abraço

      Data/hora atual: 24/11/2020, 08:42