[Resolvido]Parcelas diárias

Ola pessoal, estou com um duvida, que os amigos possam me ajudar

Tenho um gerador de parcelas, que roda certinho, tanto por mês, como por dias.

Ele pula os finais de semana caso a data caia nesses dias, mas esse é o problema caso a parcela seja diária

Explico: Gero 10 parcelas com intervalos de 1 dia, com data de inicio 27/07 e fica assim:


Dt Venc
27/07/2018
30/07/2018
30/07/2018
30/07/2018
31/07/2018
01/08/2018
02/08/2018
03/08/2018
06/08/2018
06/08/2018

Veja que ela roda as 10 parcelas, mas os dia que cai no sabado e domingo ele se acumula tudo na segunda

A ideia é nao contar o final de semana e deveria ficar assim

Dt Venc
27/07/2018
30/07/2018
31/07/2018
01/08/2018
31/08/2018
01/08/2018
02/08/2018
03/08/2018
05/08/2018
06/08/2018

o código que utilizo é esse

Dim sDT As String
Dim DT As Date
Dim freqNum As Long
Dim freq As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim ValParc As Currency, i As Byte

Set db = CurrentDb()
Set rs = db.OpenRecordset("TblLancamento") 'Abre tbl_Parcelas

If Me.fraFrequencia.Value = 0 Then
freqNum = Me.TxtMes
freq = "M"
Else
freqNum = Me.txtNumDias
freq = "d"
End If

ValParc = Me.TxtValor 'Valor de cada Parcela
For i = 1 To Me.txtNumParcelas 'Insere as Parcela na Tabela
rs.AddNew
rs("Lancamento_Banco") = TxtBanco
rs("Lancamento_Parcela") = i
rs("Lancamento_Valor") = ValParc
rs("Lancamento_Banco") = TxtFavorecido
rs("Lancamento_Banco") = TxtCCorrente
'Calcula as datas de Vencto através da função DateAdd()

sDT = DateAdd(freq, i * freqNum, Me.TxtData)
DT = CDate(sDT) '' Converto a data (string) em data (date)
'' Abaixo, testo se o vencimento cai no sábado ou domingo,
'' se cair, passo para a primeira segunda-feira
If Weekday(DT) = 1 Then
DT = DateAdd("d", 1, DT)
ElseIf Weekday(DT) = 7 Then
DT = DateAdd("d", 2, DT)
End If
rs("Lancamento_DtVencimento") = DT
rs.Update
Next
rs.Close
db.Close

Call Confirma("Confirmação de dados!", "* " & txtNumParcelas & "", "Parcelas geradas com sucesso.", _
"REG_ContaPagar")
Me.BtTxt.SetFocus
MakeTransparent Me.hWnd, 100

Obrigado e aguardo um possível ajuda

Boa tarde.

acredito que a sua lógica está equivocada na seguinte parte do algoritmo.

1. A parcela anterior vence hoje sexta, 27/07/2018, e a próxima vencerá amanhã dia 28/07 (sábado) então o sistema acrescentará dois dias e vencerá no dia 30/07 (segunda);
2. No próximo Loop, o sistema acrescentará um dia a partir de 28/07 para o vencimento da próxima parcela, ou seja, vencerá no dia 29/07 (domingo) então segundo a sua programação acrescenta um dia e vencerá dia 30/07 (segunda);
3. Seguindo na mesma lógica a ultima parcela venceu no dia 29/07 (domingo) e acrescentando um dia a próxima vencerá no dia 30/07 (segunda).

Logo teremos três parcelas vencendo no dia 30/07/2018 (segunda-feira) porque você esqueceu de acrescentar os um ou dois dias quando o vencimento recai sobre os dias não úteis (sábado e domingo).

Atenciosamente, Delson

Olá Delson.

Então já fiz esses testes, inclusive tentei fazer alguns ajustes, mas não roda, continua acumulado as datas para segunda.

Mesmo porque , eu entendi o seu pensamento, mas acontece que muitas parcelas sai assim por diária

Geralmente por cada conta que o cliente vai lançar, ele vai pedir as quantidades de parcelas e o intervalo entre elas e muitas vezes assim:

Parcelas
30 Parcelas com intervalo de 1 dia
45 Parcelas com intervalo de 1 dia
50 Parcelas com intervalo de 1 dia
75 Parcelas com intervalo de 1 dia

Então fica inviável acrescentar os um ou dois dias quando o vencimento recai sobre os dias não úteis (sábado e domingo).

Mas obrigado pela atenção

Vou fica pensando ema algo

Posta o BD que dou uma olhada para você.

Delson

Ok, vou montar e postar...

Delson

Segue o link para baixar o exemplo

Fico no aguarde

4shared.com/folder/FacASEXg/_online.html

up

Boa noite.

Envio o BD anexo. Teste e verifique se ficou de acordo.

A lógica é a seguinte: cada vez que a data do vencimento da parcela é sábado (acrescento 2 dias); quando a data do vencimento é domingo (acrescento 1 dias) e vou acumulando até o final das parcelas.
Nesta parte fiz a modificação:
criei a variável Fim_semana 'para acumular a quantidade de dias de fim de semana.

sDT = DateAdd(freq, ((i - freqNum) + Fim_semana), Me.TxtDtVencimento)

If Weekday(DT) = 1 Then
   DT = DateAdd("d", 1, DT)
   Fim_semana = (Fim_semana + 1)
   ElseIf Weekday(DT) = 7 Then
   DT = DateAdd("d", 2, DT)
   Fim_semana = (Fim_semana + 2)
End If



Abraço, Delson

Perfeito.

Muito obrigado pela atenção e pela ajuda

Ola Delson.

Antes obrigado novamente, mas estava fazendo novos testes aqui, e tem um engano nos cálculos.

As parcelas geradas diariamente fechou, esta correta, mas se eu for gerar por mês, ela da um erro, pois pula alguns meses, consegueria dar mais uma analisada?

Boa noite,

Fiz algumas correções por causa da frequência mensal.

Verifique como ficou e informe os resultados!

Abraço, Delson

Obrigado, deu certo

Valeu pela atenção

Olá Delson.

Novamente venho pedir seu auxilio em relação ao código que me passou.

Seguinte, quando informamos a sequencia do parcelamento para 1 dia ou para cada 1 mês, ele funciona normalmente, mas quando informamos essa frequência acima de 2 tanto para o mês, como para o dia ele não obedece,

Poderia da uma analisada ?


Obrigado e desde já te agradeço.

Bom dia.
Acredito que havia um erro na sua função.
Veja a parte em vermelho. Ao invés de subtração tem que ser multiplicação.
Acerte no seu código e teste!

'Calcula as datas de Vencto através da função DateAdd()
   If freq = "d" Then
      sDT = DateAdd(freq, ((i * freqNum) + Fim_semana), Me.TxtDtVencimento)
   Else
      sDT = DateAdd(freq, i * freqNum, Me.TxtDtVencimento)
   End If
   DT = CDate(sDT) '' Converto a data (string) em data (date)
   '' Abaixo, testo se o vencimento cai no sábado ou domingo,
   '' se cair, passo para a primeira segunda-feira
   If Weekday(DT) = 1 Then
   DT = DateAdd("d", 1, DT)
   Fim_semana = (Fim_semana + 1)
   ElseIf Weekday(DT) = 7 Then
   DT = DateAdd("d", 2, DT)
   Fim_semana = (Fim_semana + 2)
   End If
   rs("Lancamento_DtVencimento") = DT
   rs.Update
   Next
   End Function

Abraço, Delson

Muito obrigado DELSON, funcionou corretamente

Mas ainda teria um pequeno detalhe, o código não esta partindo da data de vencimento.

Desde já muito obrigado

Ajuste a parte em vermelho e teste!

'Calcula as datas de Vencto através da função DateAdd()
      If freq = "d" Then
      sDT = DateAdd(freq, (i * freqNum - freqNum - 1) + Fim_semana, Me.TxtDtVencimento)
   Else
      sDT = DateAdd(freq, i * freqNum - freqNum, Me.TxtDtVencimento)
   End If
   DT = CDate(sDT) '' Converto a data (string) em data (date)
   '' Abaixo, testo se o vencimento cai no sábado ou domingo,
   '' se cair, passo para a primeira segunda-feira
   If Weekday(DT) = 1 Then
   DT = DateAdd("d", 1, DT)
   Fim_semana = (Fim_semana + 1)
   ElseIf Weekday(DT) = 7 Then
   DT = DateAdd("d", 2, DT)
   Fim_semana = (Fim_semana + 2)
   End If
   rs("Lancamento_DtVencimento") = DT
   rs.Update
   Next
   End Function


Abraço, Delson

Perfeito, muito obrigado

Obrigado pelo retorno.

Bons estudos, Delson

Só pra atualizar tenho um codigo que faz de acordo com a opção no sistema pode ser numa tabela configuração onde se coloca valor 1 para antecipar e 2 para atrasar tipo se a parcela cair no sabado ou domingo pode colocar pra segunda ou pra sexta, a data de vencimento.


' VARIAVEIS DE UTILIZAÇÃO
Dim Y As String
Dim dtVencimento As Date
Dim dtVencimento2 As Date

' BUSCA A CONFIGURAÇÃO NA TABELA TB PODERIA SER VARIAVEL
Y = DLookup("Parcela_Dias_Uteis", "Temp_Empresa")

'ABRE TABELA PARA INSERIR PARCELA
Set dbp = CurrentDb()
Set rsp = db33.OpenRecordset("Temp_Compra_Parcela")

For i = 1 To Me.Qtd_Parcela
rsp.AddNew
rsp("id_compra") = Me.id_compra
rsp("data_compra") = Me.data_compra
rsp("id_fornecedor") = Me.id_fornecedor
rsp("fornecedor") = Me.fornecedor
rsp("status") = "ABERTA"
rsp("n_parcela") = ""
rsp("valor_conta") = Me.valor_parcela
rsp("juros_porcentagem") = Me.juros_porcentagem
rsp("multa_porcentagem") = Me.multa_porcentagem
rsp("juros_fixo") = Me.juro_fixo
rsp("multa_fixo") = Me.multa_fixo
' GERA PARCELA NA VARIAVEL
dtVencimento2 = DateAdd("d", (i * intervalo), CDate(Me.data_compra))
' VERIFICA A PARCELA SE CAI NO FINAL DE SEMANA E CORRIGE A DATA
dtVencimento = fncAjustaData(dtVencimento2, IIf(Y = 1, True, False))

' GERA A PARCELA
rsp("vencimento") = dtVencimento

rsp.Update
Next
rsp.Close
dbp.Close
Me.Frm_Compra_Parcela.Requery 'Atualiza o SubForm

Boa noite!

    Segue o código para parcela diária que uso e funciona perfeitamente. É só adaptar a seu sistema.

Caso tenha dúvida poste seu BD.

----------------------------------------------------------------------

Dim sDT As String
Dim DT As Date
Dim freqNum As Long
Dim freq As String
Dim db As DAO.Database, rs As DAO.Recordset
Dim ValorCheque As Currency, I, Fim_semana As Byte

Set db = CurrentDb()
Set rs = db.OpenRecordset("tbl_LancChequeDet") 'Abre Tbl_ContasAreceber
         
       ValorCheque = Me.txtTotalRecebe / Me.QtdeParcelas 'Valor de cada Parcela
   
   For I = 1 To Me.QtdeParcelas  'Insere as Parcela na Tbl_ContasAreceber
       rs.AddNew
       rs("Cod_Lançamento") = Me.Cod_Lance
       rs("NumCheque") = Right("000" & I, 3) & "/" & Right("000" & Me.QtdeParcelas, 3)
       rs("ValorCheque") = Me.txtTotalRecebe / Me.QtdeParcelas
       rs("ValorFixo") = Me.txtTotalRecebe / Me.QtdeParcelas
       'Calcula as datas de Vencto através da função DateAdd()
   sDT = DateAdd("d", ((I - 1) + Fim_semana), Me.txtDt_1Parcela)
   DT = CDate(sDT) '' Converto a data (string) em data (date)
   '' Abaixo, testo se o vencimento cai no sábado ou domingo,
   '' se cair, passo para a primeira segunda-feira
   If Weekday(DT) = 1 Then
   DT = DateAdd("d", 1, DT)
   Fim_semana = (Fim_semana + 1)
   ElseIf Weekday(DT) = 7 Then
   DT = DateAdd("d", 2, DT)
   Fim_semana = (Fim_semana + 2)
   End If
       rs("VencCheque") = DT
       rs("DataLanc") = Me.txtDataLanc
       rs("Taxa") = Me.txtTaxa
       
       rs.Update
   Next
   rs.Close
   db.Close
   Me.frm_LancChequeDetSub.Requery  'Atualiza o SubForm
   Me.btn_Diário.enabled = False