Lançar vencimentos

Boa noite:

Prezados a muito tempo tento modificar um código, que não e meu para gerar parcelas que atendam a um intervalo de dias.
Bom o código funciona perfeitamente se o intervalo for  com um numero igual de dias por exemplo 7/14/21 15/30/45 30/60/90 .
Porem se eu preciso por exemplo de um intervalo de 28/42 dias, vejam que o primeiro intervalo é de 28 dias, mas o segundo e de apenas 14.
E é ai ai que o código não fica exatamente como queria, pois ele pega o valor do pedido divide em duas parcelas , mas lança ambas com 28 dias :
Exemplo: digamos que mau compra feita hoje 20/09/2016
Teria de ter  a primeira parcela vencendo dia 18/102016 e a segunda dia 01/11/2016, porem ele joga a segunda parcela para 15/11/2016.
ou seja joga mais 28 dias.
Tentando resolver isso eu criei na tabela um campo com um segundo intervalo, minha ideia e fazer o Código pegar  primeiro intervalo  para gerar a primeira parcela, e as demais não importa quantas parcelas sejam pegue o segundo .
abaixo segue o código:
Private Sub Gerar_Click()
On Error GoTo Err_Gerar

 Mensagem = "Lançamento de Contas"
 
 Dim ValorParcela As Integer
 If IsNull([CpDtEmissao]) Then [CpDtEmissao] = Date
 
 If IsNull(CpCdCliente) Then
   MsgBox "Digite o código do cliente", 64, Mensagem
   [CpCdCliente].SetFocus
   Exit Sub
 End If
 
 If IsNull([Selecionar Vendedor]) Then
   MsgBox "Selecione um vendedor", 64, Mensagem
   [Selecionar Vendedor].SetFocus
   Exit Sub
 End If
 
 If IsNull([Selecionar Condicao]) Then
   MsgBox "Selecione uma condição", 64, Mensagem
   [Selecionar Condicao].SetFocus
   Exit Sub
 End If

 If IsNull([cpValorTotal]) Then
   MsgBox "Digite o valor total da compra", 64, Mensagem
   [cpValorTotal].SetFocus
   Exit Sub
 End If

 If IsNull([Selecionar FormaDePag]) Then
   MsgBox "Selecione uma forma de pagamento", 64, Mensagem
   [Selecionar FormaDePag].SetFocus
   Exit Sub
 End If

 Dim Bd As Database
 Dim Usuario As Recordset
 Set Bd = DBEngine.Workspaces(0).Databases(0)
 Set Usuario = Bd.OpenRecordset("Usuario", DB_OPEN_TABLE)

 Usuario.Index = "IndiceNumero"
 Usuario.Seek "=", 1

 If Not Usuario.NoMatch Then            'usado para gravar o usuario
   SalvaUsuario = Usuario("CdUsuario")
   Usuario.Close
 End If
 
 Dim MeuCliente As Database
 Dim Cliente As Recordset
 Dim ÁreaCliente As Workspace

 Set ÁreaCliente = DBEngine.Workspaces(0)
 Set MeuCliente = ÁreaCliente.OpenDatabase("F:\access\Sistema\Dados\DadosE.mdb")
 Set Cliente = MeuCliente.OpenRecordset("Cliente")

 Cliente.Index = "Índice do Cliente"
 Cliente.Seek "=", [CpCdCliente]
 
 Dim Meubd As Database
 Dim Receber As Recordset
 Dim Área As Workspace

 Set Área = DBEngine.Workspaces(0)
Set Meubd = Área.OpenDatabase("F:\access\Sistema\Dados\DadosE.mdb")
 Set Receber = Meubd.OpenRecordset("Receber")

 Receber.Index = "IndiceCdDoc"
 Receber.Seek "=", [Selecionar Documento]

 Dim Y As Variant
 
 Y = DMax("[CdDoc]", "Receber")
 
 If IsNull(Y) Then
   Y = 0
 End If
 
 If Not Receber.NoMatch Then
   Receber.Close
   [Selecionar Documento].SetFocus
   Exit Sub
 Else
   Receber.AddNew
    Receber("CdDoc") = (Y + 1)
     Receber("CdCliente") = Me.CpCdCliente
     Receber("NumSaida") = [CpNota]
     If IsNull([CpDtEmissao]) Or ([CpDtEmissao]) = " " Then
        Receber("DtEmissao") = Date
     Else
       Receber("DtEmissao") = [CpDtEmissao]
     End If
     Receber("CdCliente") = Me.CpCdCliente
     Receber("CdVendedor") = [Selecionar Vendedor]
     Receber("CdPagamento") = [Selecionar Condicao]
     Receber("ValorTotal") = [cpValorTotal]
     Receber("CdFormaDePag") = [Selecionar FormaDePag]
     Receber("CdUsuario") = SalvaUsuario
     If Not Cliente.NoMatch Then   'Atualiza o nº de compra do cliente
       Cliente.Edit
         If IsNull(Cliente("NumCompra")) Then
           Cliente("NumCompra") = 0
         End If
         Cliente("NumCompra") = (Cliente("NumCompra") + 1)
       Cliente.Update
     End If
     [Selecionar Documento] = (Y + 1) ' Receber("CdDoc")
     Forms![LancaReceber]![CpDtEmissao] = Receber("DtEmissao")
     If ([Selecionar Condicao] = 1) Then
       If ([Selecionar FormaDePag] = 1) Or ([Selecionar FormaDePag] = 2) Then
        Receber("Extracao") = 1
       End If
     Else
       Receber("Extracao") = 0
     End If
     Receber("Exclusao") = 0
   Receber.Update
 End If

 Receber.Close
 Cliente.Close

 Dim Meu As Database
 Dim Parcela As Recordset
 Dim ÁreaParcela As Workspace

 Set ÁreaParcela = DBEngine.Workspaces(0)
 Set Meu = ÁreaParcela.OpenDatabase("F:\access\Sistema\Dados\DadosE.mdb")
 Set Parcela = Meubd.OpenRecordset("ParcelaReceber")

 Parcela.Index = "IndiceCdDoc"
 Parcela.Seek "=", [Selecionar Documento], Forms![LancaReceber]![Selecionar Condicao].Column(2)
 
 Contador = Forms![LancaReceber]![Selecionar Condicao].Column(2) 'Nº parcelas
[size=16]dias = Forms![LancaReceber]![Selecionar Condicao].Column(3)     'intervalos( creio que seria aqui onde deveria começar a mudança do codigo aqui ele pega o primeiro intervalo)[/size]
 Entrada = Forms![LancaReceber]![Selecionar Condicao].Column(4)     'entrada

 If Not Parcela.NoMatch Then
   Exit Sub
 Else
   Valor = [cpValorTotal] / Contador
   ValorParcela = Int(Valor)
   AcumulaParcela = 0
   
   If Entrada = False Then
     DtVenc = Forms![LancaReceber]![CpDtEmissao]
   Else
     DtVenc = DateAdd("d", (-dias), Forms![LancaReceber]![CpDtEmissao])
   End If

   For i = 1 To Contador
     Parcela.AddNew
       Parcela("CdUsuario") = SalvaUsuario
       Parcela("DtVenc") = DtVenc
       Parcela("CdDoc") = [Selecionar Documento]
       Parcela("CdParcela") = i
       DtVenc = DateAdd("d", (dias), Parcela("DtVenc"))
       DiaSemana = WeekDay(DtVenc)
       If (DiaSemana = 1) Then
         DtVenc = DateAdd("d", 1, DtVenc)
       End If
       Parcela("DtVenc") = DtVenc
       Parcela("ValorReceber") = ValorParcela
       If ([Selecionar FormaDePag] = 1) Then
         Parcela("DtRecebido") = Parcela("DtVenc")
         Parcela("ValorRecebido") = Valor
         Parcela("Situacao") = "Pago"
         Parcela("Especie") = "Dinheiro"
         End If
        If ([Selecionar FormaDePag] = 4) Then
         Parcela("Situacao") = "Emitido Duplicata" 'Campo situação recebe Emitido Duplicata
         Parcela("Especie") = "Duplicata"
         Parcela("Bancos") = Me.Bancos
          End If
       If ([Selecionar FormaDePag]) = 2 Then
        Parcela("Especie") = "Cartão"
         Parcela("Situacao") = "Emitido"
         End If
       If [Selecionar FormaDePag] = 3 Then
        Parcela("Especie") = "Cheque- Pré"
         Parcela("Situacao") = "Emitido"  'Campo situação recebe emitido
         End If
         If ([Selecionar FormaDePag]) = 5 Then
          Parcela("Especie") = "Depósito em C/C"
         Parcela("Situacao") = "Emitido"
         End If
       If ([Selecionar FormaDePag]) = 6 Or ([Selecionar FormaDePag]) = 7 Then
       Parcela("Situacao") = "Emitido"
         Parcela("Especie") = "Cheque"
         End If
          If ([Selecionar FormaDePag]) = 8 Then
       Parcela("Situacao") = "Emitido"
         Parcela("Especie") = "Boleto e Cheque"
          Parcela("Bancos") = Me.Bancos
       End If
       
       AcumulaParcela = AcumulaParcela + Parcela("ValorReceber")
     Parcela.Update
   Next i
   If AcumulaParcela <> [cpValorTotal] Then
     Parcela.Seek "=", [Selecionar Documento], 1
     If Not Parcela.NoMatch Then
       DiferencaParcela = [cpValorTotal] - AcumulaParcela
       Parcela.Edit
         Parcela("ValorReceber") = (Parcela("ValorReceber") + DiferencaParcela)
       Parcela.Update
     End If
   End If
 End If
 
 [ListaParcelas].Requery
 Parcela.Close
 [CpCdParcela].SetFocus
If IsNull(Me.CpNota) = True Then
 Dim stDocName As String
DoCmd.SetWarnings False
   stDocName = "Atduplicatas"
   DoCmd.OpenQuery stDocName, acNormal, acEdit
DoCmd.SetWarnings True
End If
Exit_Gerar:
 Exit Sub

Err_Gerar:
 MsgBox Error$
 Resume Exit_Gerar

End Sub

Espero ter explicado bem.
Att

Ney Santos

Olá!

amigo aqui no forum existe exemplos quee geram parcelas em um determinado período podendo ainda sinalizar feriados, domingos e etc.

olhe algum se atende

https://www.maximoaccess.com/search?mode=searchbox&search_keywords=parcelas&show_results=topics

sds

Prezado Nois, com certeza existem vários tópicos sobre gerar parcelas,
o motivo de eu postar essa duvida e que o código que postei faz parte de um sistema , que eu não sou o "Pai"
mas o "Padastro"Rss...
Digo isso pois no ano de 2003 fui chamado "as pressas "por um cliente para ajuda-lo pois o sistema estava com problemas e o desenvolvedor havia se mudado para outra cidade, mesmo tento pouco conhecimento, pois n época eu estava começando aceitei o desafio de ajudar o cliente.
Bom pra você ter uma ideia quando fui apresentado ao sistema pela primeira vez ele rodava no access 2.0 isso mesmo nem no 97 ele rodava ainda.
De lá para cá ele sofreu"N" alterações e foi adaptado para mais de 10 tipos diferentes de fabricas.
Passando de fabrica de expositores a fabrica de churrasqueiras, baterias etc.. sempre sofrendo alterações de acordo com a necessidade do cliente.
Tenho outro sistemas, mas sempre tive vontade de fazer essa mudança na geração de parcelas desse sistema.
Qualquer outro código que eu implanta-se não casaria com ele, pois existem muitos outros fatores agregados.
De qualquer forma agradeço as dicas do link

Att..

Ney Santos

bom dia Ney Santos,
me explique uma coisa:
quais vão ser os intervalos para o lançamento destas parcelas?
3 parcelas: 30/60/90?
3 parcelas 30/45/60
vale lembrar que é possivel fazer isto, mas você precisa configurar um intervalo logico para não embolar o sistema. Uma outra coisa é que eu estou achando o seu codigo meio grando demais. Se possivel posta apenas a tabela e este form de lançamento pra gente dá uma olhada melhor.

Bom dia Rubens, eu explico:
Forms![LancaReceber]![Selecionar Condicao].Column(3)===> nesta linha  o codigo pega o primeiro intervalo, ele vem de uma combobox onde a terceira coluna tem o numero de dias do intervalo.
na mesma combobox na coluan 5 teria um segundo intervalo.
entao se for 30/60/90 o intervalo e de 30 dias e ai nao tem problena as parcelas ficam com datas corretas, alias  se o intervalo for de dias iguais funciona perfeita mente, como ja expliquei. pode ser 30 , 15 , 45 nao importa funciona bem.
oque eu queria era fazer o codigo entender que na proxiam parcela , ouse ja aprtir da segunda ele buscase o outro intervalo.
no caso :Forms![LancaReceber]![Selecionar Condicao].Column(5).
Quanto ao tamanho do codigo eu tabm explico:
1º el gera um codigo para o lançamento na tabela REceber
2 ª depois de gerado o codigo vem a segunda parte que e gerar as parcelas referente a este codigo da tabela receber.
as parcelas são geradas na tabela parcela recber, ligadas pelo codigo gerado( igual como fazemos com um pedido e e lançamos os detalhes numa tabela detalhes do pedido.)

3º dependendo da forma de pagamento o tipod e pagamento e gravado( Cheque, boleto, Dep. em C/C etc..)

att

Ney Santos

Boa tarde!
estou postando um BD para ajudar na explicação.
Por se tratar de Formulario desvinculados, descompacte na rais ou seja "C:"
para poder funcionar.

Olá Ney, tudo bem!!

Vou entrar nesta tarefa junto com os Amigos..

Fiz uma alteração no código do Mestre JPaulo para atender a esta necessidade que foi minha tambem.
Tentei fazer no seu código, más me atrapalhei todo.
como voce tem a afinidade com o mesmo, tente adaptar a sua necessidade.
No meu código apenas criei a tabela onde configuro os prazos e faço a chamada na combo cbo.Intervalo

Abraços

Prezado Celso, muito obrigado!
Depois de 2 dias testando e retestando consegui ajustar a minha necessidade
deu trabalho encaixar parte do código , mas funcionou.
Porem tenho uma duvida seria possível incluir um terceiro intervalo?
Por exemplo: forma de Pagamento 30/45/70 dias.
o terceiro intervalo e diferente do segundo pois e de 25 dias.
Seria possível adicionar ao código?

Att
Ney

Criei mais um campo na tabela chamado Intervalo3
ate alterei meu codigo criando mais uam variavel noca so variavel K
Dim X As Double, W As Double, K As Double
 W = Me.[Selecionar Condicao].Column(5)
 K = Me.[Selecionar Condicao].Column(6)
 X = Me.CpDtEmissao
resumindo o codigo no campo que gera as datas de venc. coloquei assim
Parcela.AddNew
X = X + Val(W)
Parcela("CdUsuario") = SalvaUsuario
Parcela("DtVenc") = DtVenc
Parcela("CdDoc") = [Selecionar Documento]
Parcela("CdParcela") = I
' DtVenc = DateAdd("d", (dias), Parcela("DtVenc"))
DtVenc = DateAdd("d", X, ([Selecionar Condicao].Column(3) - Val(W) + ([Selecionar Condicao].Column(5) - Val(K))))
portem nao da o resultado esperado.

Olá Ney

mas o caminho é porai, estou tentando também fiz exatamente oque vc fez em relação a tabela.
Quanto aos calculos de vencto, sabendo que a parcela com diferença seria depois da 2, temos que pensar como fazer para calcular as primeiras e adicionar a diferença de dias na 3

vamos seguir tentando

Abraços

ja fiz varios teste mudando  a linha onde geara s datas de venciemntos nenhuma deu certo
oque percebo e que na maiora das vezes ele ele coloca a 1 parcela com venc correto mas a segunda e  a terceira ele soma os dias de eintervalo e adiciona.]Exemplo:
Prazo 28/42/55 dias
Data emissão 22/09/2016
Venc. 1 20/10/2016 correto
venc. 2 16/11/2016 errado o correto seri 03/11
venc  3  13/12/2016 errado o correto seria 16/11
como voce pode ver ele somou  o 2º e o 3º intervalo (14 e 13 dias)  =27
e adiciona nas outras parcelas.

Olá..
Estou tambem tentando achar um caminho, mas tá dificil.
Eu já percebi isto tambem nos teste que estou fazendo, mas sempre vai ter problemas quando for fora do padrão.
O padrão é sempre a 1 parc. tem as vezes um prazo maior e as demais segue um periodo igual, tipo aquela promoções "Voce tem 120 dias para pagar a 1 parcela".

Vamos pensar, oque vamos fazer quando existir mais de tres parcelas?, oque estamos tentando fazer já não vai dar certo, porque a diferença teria que ir para a ultima parcela.

Tudo o que é fora do padrão terá que sempre estar mudando.

Mas neste caso o caminho é tentar eliminar as parcelas que estão calculando certo, e tentar calcular as próximas

Vou esquentar a cabeça mais um pouco

Att+

Olá...

E haeee, esquentou a cabeça?

Como tudo tem uma solução, eu acho que encontrei o caminho.
Será para qualquer periodo e parcelas, acho que vai resolver este problema de uma vez.
Nos primeiros testes esta funcionando legal, agora vou incrementar no código.
Pra segunda ou terça eu te passo.

Abraços

aguardo ansiosamente rss

Celso alguma novidade?

Olá...

Lá vai

se ao mandar gerar parcelas, se der algum erro seleciona um prazo e manda calcular de novo.
Lança prazos pelo formulario prazo de pagamentos, mas veja o procedimento nas tabelas como foi feito

Aguardo retorno

Abraços

bom dia Celso
Tem uma rapida olhada e pelo que entendi vc criou um a nova tabela é isso?
E os intervalos serão cadastrados nela.
Vou dar uma estudada mais a fundo para ver se compreendo melhor.

Bom dia Ney
É isto mesmo, quando for cadastrar um prazo no form
EX: 10/11/12/13/14/15/16/17
Então nº de parcelas = 8
No Subform tem que inserir os 8 periodos de dias ex:
NDias 1º linha ficaria 10, 2º linha 11,........, 8º linha 17
Isto para facilitar o trabalho com qualquer prazo que possa precisar
o código busca estes dias para gerar os venctos, foi a maneira que encontrei tirando algumas idéias de
tópicos pesquisados aqui no fórum.
Se tiver outra idéia por favor me retorne

Abraços

Completando,
No exemplo que te passei, altere o Campo NDias da tabela nos códigos de 1 a 15 que esta com NDias=1 para de 1 a 15 sequencialmente, esqueci de alterar

Abraços

Boa Tarde Celso
Entendi, perfeitamente agora vounter de quebrar a cabeça pra
Incluir seu código no meu, visto que a forma de calculo mudou radicalmente
e como você pode ver meu código implementa varias funções apos gerar a tabela isso porque
preciso ter um controle absoluto do que esta em dia e do que está atrasado.
Tambem vi que e preciso colocar um código que não permita que você coloque mais prazos que o numero de parcelas.
Talvez um campo contador ou algo parecido.
Vou pensar e passo pra você.

Olá ney..

Oque não permite que o usuário altere o prazo você vai encontrar no evento após atualizar da cboCodPrazoPagto do meu exemplo, mas segue ele

Private Sub cboCodPrazoPagto_AfterUpdate()
Me.NºDeParcelas = Me.cboCodPrazoPagto.Column(2)
Me.NºDeParcelas.Locked = False
Me.NºDeParcelas.SetFocus
If Not IsNull(Me.NºDeParcelas.Value) Or Me.NºDeParcelas.Value <> "" Then
MsgBox "Número de parcelas definido de acordo com prazo selecionado!!!", vbInformation, "Atenção!"
Me.DataFaturamento.SetFocus
End If
End Sub


Agora quanto ao seu código, não dá para fazer em blocos.
1º executa alguma coisa e depois outra, é apenas uma idéia.
Digo porque acabei de alterar um código de um botão de comando que executava uma função e depois tinha outro botão para executar outra função.
Alterei fazendo a fusão dos dois em um só, mas desta maneira
1º Bloco executa a primeira parte e depois outra.

Abraços

Olá Ney...

Acho que voce já deve ter esquentado a cabeça né, então como voce já tinha adaptado o código anterior, pra te ajudar ve se fica mais fácil.
Substitua o código atual por este.
ele esta quase original.

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 ValorParcial <= 0 Then


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
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



espero que te Ajude

Abraços

Olá..
como andas?, já conseguiu implementar?

Abraços

BOA TARDE!
To numa correia só, ainda não consegui pois alemd e criar a nova tabela tenho de fazer os sajustes de ligação entre elas.

Olá meu amigo..

Já conseguiu resolver, Estou curioso(rsrsrs)

precisando de ajuda e só falar!!

Abraços

Boa tarde!
Ainda não.Na verdade ta tão corrido que não tive tempode mudar a programação como voce sabe meu código e bem extenso e tenho de faer uam mudança radical.