[Resolvido]Gerador de Parcelas Repetindo Parcelas

Bom dia Mestres,

Tenho um gerado de parcelas que estou tentando adaptar a meu projeto, porém quando mando calcular as parcelas ele o faz, mas duplica as parcelas as vezes mais 1000 vezes, como se o Loop não parasse, segue abaixo o código:

Código:

Private Function Calc_parc()
On Error Resume Next

Dim rs As DAO.Recordset
Dim rs1 As DAO.Recordset
Dim Rs2 As DAO.Recordset
Dim I As Byte, X As Integer, StrParc As String

Set rs = CurrentDb.OpenRecordset("select * from tblPagamentosParcelas where CodPagto = " & Me.CodPagto & "")
Set rs1 = CurrentDb.OpenRecordset("select * from tblPagamentosParcelas where CodPagto = " & Me.CodPagto & " and quitada = -1")
Set Rs2 = CurrentDb.OpenRecordset("SELECT CodPrazoPagtoDet, CodPrazoPagto, NDias FROM tblPrazoPagamentoDet WHERE CodPrazoPagto = " & Me.cboCodPrazoPagto.Column(0) & ";")
If Not rs1.EOF Then
   MsgBox "Este Pagamento ja foi parcelado e cont?m pagamentos efetuados. " & Chr(10) & "" _
   & "N?o ser? possivel refazer parcelamento !!!", vbCritical
   Set rs1 = Nothing
Exit Function
End If

If Not rs.EOF Then
 If MsgBox("J? existe um parcelamento para este Pagamento !!! " & Chr(10) & "" _
   & "Deseja substituir pelos novos valores? ", vbYesNo + vbExclamation + vbDefaultButton1, "Parcelamento") = vbYes Then
   DoCmd.SetWarnings False
   DoCmd.RunSQL "Delete * from tblPagamentosParcelas where CodPagto = " & Me.CodPagto & ""
   DoCmd.SetWarnings True
   Else
   Exit Function
 End If
End If

If Not ValorParcial <= 0 Then
Do While Not Rs2.EOF
For I = 1 To Me.N?DeParcelas
With rs
   .AddNew
       !CodPagto = Me.CodPagto
       !N?DeParcelas = I & "/"
       !N?DeParcelas = I & "/" & Me.N?DeParcelas
       !ValorDasParcelas = Me.ValorDasParcelas
 
   If Me.chkEntrada = False Then
   !DataDoVencto = DateAdd("d", Rs2!NDias, Format(Me.DataFaturamento, "dd/mm/yyyy"))
   
   Else
   !DataDoVencto = DateAdd("m", I - 1, (Me.DataFaturamento))
    Me.cboCodPrazoPagto = "30 Dias"
   End If
   
   !DataPrevPagto = !DataDoVencto
 
  .Update
End With
Rs2.MoveNext
Next I
Loop

Else
   DoCmd.SetWarnings False
   DoCmd.RunSQL "Delete * from tblPagamentosParcelas where CodPagto = " & Me.CodPagto & ""
   DoCmd.SetWarnings True
End If

rs.Close
Set rs = Nothing
   Me.frmPagamentosParcelas.Requery
   MsgBox "Valores inseridos com sucesso!!!"
   Me.Fornecedor.SetFocus
   
Exit_Calc_Parc:
   Exit Function
   
Err_Calc_Parc:
   MsgBox Err.Description
   Resume Exit_Calc_Parc
   
   Me.Fornecedor.SetFocus

End Function

Seja bem vindo amigo, bom, não, não vou tentar corrigir seu código, porém, tenho em um de meus sistema, um código que gera automaticamente parcelas a pagar. Seguem em o referido código, veja se lhe ajuda.

Eu coloquei ele dentro de um botão (evento ao clicar) uso apenas o formulário principal e um subformulário para as parcelas.

Código:


Dim I As Integer
Dim StrDateAdd As Date
Dim StrValorParc As Double
Dim Parc As String
Dim Tipo As String
Dim Descri As String

StrValorParc = Me.Valor_Doc / Me.Parcelas
For I = 1 To Me.Parcelas
StrDateAdd = DateAdd("m", I - 1, Format(Me.DtVencimento, "dd/mm/yyyy"))
StrParc = I & "/" & Me.Parcelas
Descri = Me.Historico.Value
Tipo = Me.Tipo.Value

CurrentDb.Execute "INSERT INTO Parcelas(IdConta,TipoConta,Descricao,CpData,CpValor)" _
                & " Values(""" & Me.IdConta.Value & """, """ & Tipo & """, """ & Descri & """, #" & Format(StrDateAdd, "mm/dd/yyyy") & "#, """ & StrValorParc & """);"
Next I
'Status.Value = "PARCELAS GERADAS"
Me.Parcelamento.Requery
MsgBox ("AS PARCELAS FORAM GERADAS COM SUCESSO")
'Me.lstParcelas.Requery


Boa noite Claudio,

Devido a minha estrutura não consegui adaptar vosso código, mas agradeço a ajuda e o aprendizado.

Espero que consiga resolver seu problema meu amigo. Boa noite.

Atenciosamente,

Cláudio Ramos

Olá..

Este código foi eu que adaptei aproveitando o exemplo do nosso mestre JPaulo e deixei no Repositório de exemplos.
Não vejo erros no código com exceção do caracter " ? " em algumas linhas do seu código como abaixo.

!N?DeParcelas = I & "/"
!N?DeParcelas = I & "/" & Me.N?DeParcelas


Tente corrigir e teste, mas o ideal seria postar a sua base de dados só com as tabela, consultas e formulários envolvidas para podermos analisar e encontrar o erro

veja o exemplo neste tópico funcionando corretamente

https://www.maximoaccess.com/t28063-prazos-de-pagamento-nova-atualizacao-no-codigo-do-mestre-jpaulo-parcelas_2008_old

Aguardo retorno

Boa tarde Celso,

Exatamente este projeto que estou adaptando ao meu, mas esta gerando muitas parcelas.
Esse erros estão no nome do campo que se chama "NºDeParcelas"
Creio que seja por conta desse caracter especial "º"

Testei o arquivo que me indicou e esta ocorrendo o mesmo erro!



Obrigado

Olá..

Me de detalhes de como chegar neste erro no meu exemplo para eu verificar e corrigir



Abraços

Celso,

O erro na verdade, não é um erro. Se deixar o campo Prazo de Pagamento em branco ocorre. Com ele preenchido, o processo ocorre normalmente. Eu estava deixando o campo em branco e colocando a quantidade de parcelas manualmente.
Só coloquei obrigatoriedade no preenchimento do campo para não esquecer mais e tudo certo.

Muito obrigado pela atenção.

Agora tudo normal.

Olá..

Realmente este campo não pode ficar em branco e o numero de parcelas deve vir pré definido do formulário de prazos de pagamento.

Na realidade este campo de números de parcelas deve ficar bloqueado para edição e também não receber o foco.

Mas em testes aqui encontrei outro erro que estou corrigindo e te passo ao terminar, refere-se a caixa de seleção intervalo mensal que em certo momento perde a funcionalidade e gera erro.

Na verdade este comando não tem sentido, isto pelo simples motivo de que os prazos de pagamentos e números de parcelas devem ser prè definidos como dito acima.

Se eu quero um parcelamento com números X de parcelas e vencimentos com 30 dias eu devo pré definir na tabela prazos de pagamento e selecionar no campo prazo de pagamento.

Vou corrigir o código e te retorno

Abraços

Olá...

Segue novo exemplo com as alterações ditas acima e também com correção nos nomes dos campos (retirado o caracter)

Qualquer dúvidas retorne


Abraços