[Resolvido]Adaptar Gerador de Parcelas

Olá amigos!

Gostaria de adaptar esse código para que o número das parcelas saíssem com nº + uma letra fixa.
Ex:
001-A
002-A
003-A

Obs: o campo "Nº_Documento" está definido como Texto.

Segue código:

If Me.Valor__Parcelar_01 <= 0 Then 'Se valor do contrato for <= 0
Exit Sub
End If
'Salva o contrato
DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70
Dim db As Database, rs As Recordset
Dim ValorPac As Currency, I As Long

Set db = CurrentDb()
Set rs = db.OpenRecordset("Tbl_Vendas_Sub_Parcelas") 'Abre Tbl_Vendas_Sub_Parcelas
ValorPac = Me.Valor__Parcelar_01 / Me.Numero_Parcelas_01 'Valor de cada Parcela

For I = 1 To Me.Numero_Parcelas_01 'Insere as Parcela na tbl
rs.AddNew
rs("Codigo") = Me.Código
rs("Nº_Documento") = I
rs("Valor_Parcela") = ValorPac
'Calcula as datas de Vencto através da função DateAdd()
rs("Vencimento") = DateAdd("m", I - 1, Me.Data_emissao)
rs.Update
Next
rs.Close
db.Close
Me.Frm_Vendas_Sub_Parcelas.Requery 'Atualiza o SubForm


Como posso fazer isso?

Desde já agradeço!

Chamon

Boa Tarde,

Coloque o "-A" depois do I nesta linha

rs("Nº_Documento") = I & "-A"

Sds,

Perfeito!

Muito obrigado!

Desculpem reabrir esse tópico, mas ainda ficou uma dúvida sobre esse código.

Ele pega o Valor a parcelar e divide pelo nº de parcelas, gerando o valor de cada uma.
Porém se por exemplo o valor a parcelar for de 100,00 e em 03 parcelas, ele gera 3 de 33,33 = 99,99.

Existe uma maneira automática, de uma das parcelas, por exemplo a última, acrescentar 0,01 ficando 33,34, para fechar o valor em 100,00?

1-A 33,33
2-A 33,33
3-A 33,34

Desde já agradeço.

Chamon

Chamon,

Veja como funciona o código aqui EXEMPLO

Chsestrem, é exatamente esse modelo que preciso. Porém já fiz diversos testes, mas não consegui adaptar o meu código (já citado aqui) com o do exemplo que vc sugeriu.

Se vc ou outra pessoa puder me ajudar.

Desde já agradeço.

Chamon

Não testei, mas pode ser algo mais ou menos assim:

Código:

For I = 1 To Me.Numero_Parcelas_01 'Insere as Parcela na tbl
rs.AddNew
rs("Codigo") = Me.Código
rs("Nº_Documento") = I
If I < Me.Numero_Parcelas_01 Then
    rs("Valor_Parcela") = ValorPac
Else  'é a última parcela
    rs("Valor_Parcela") = Me.Valor__Parcelar_01 - (ValorPac * (I - 1))
End If
'Calcula as datas de Vencto através da função DateAdd()
rs("Vencimento") = DateAdd("m", I - 1, Me.Data_emissao)
rs.Update
Next

Obrigado Cláudio, mas ainda não funcionou.

Eu precisaria do banco de dados para testar e corrigir o código.

Segue anexo Cláudio.

Att.,

Chamon

Substitua

rs("Valor_Parcela") = Me.Valor__Parcelar_01 - (ValorPac * (I - 1))

por

rs("Valor_Parcela") = Me.Valor__Parcelar_01 - (Format$(ValorPac, "#.00") * (i - 1))

Bom dia Cláudio!

Seu código funcionou. Muito obrigado!

Agora estou tentando adpta-lo ao modelo do bd Parcelas_Cartoes, que tem três opções de divisão da parcela:
Ex: 100,00 / 3

Unidade Centavos
1/3 - 33,34
2/3 - 33,33
3/3 - 33,33

ou Dezena de centavos

1/3 - 33,40
2/3 - 33,30
3/3 - 33,30

ou ainda Centavos na 1ª Parcela

1/3 - 34,00
2/3 - 33,00
3/3 - 33,00

Também achei mto interessante, que após inserir as parcelas, ele as reconhece e pergunta se desejamos substituí-las pelos novos valores, sendo que no modo atual o sistema simplesmente continua adicionando mais parcelas.

Alguma sugestão de como posso fazer isso?

Mais uma vez, muito obrigado!

Tentei adaptar a Função para que ele funcionasse de acordo com a última postagem, mas quando clico no botão de comando, ele não gera as parcelas e apenas emite a mensagem: "Valores inseridos com sucesso"!!!. "Deseja inserir novo registro?"
A Função atualmente está assim:

Private Function Calc_parc()
Dim rs As DAO.Recordset, i As Byte
Dim rs1 As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("select * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & "")
Set rs1 = CurrentDb.OpenRecordset("select * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & " and Quitada = -1")
If Not rs1.EOF Then
MsgBox "Este Venda já foi parcelada 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 esta Venda !!! " & Chr(10) & "" _
& "Deseja substituir pelos novos valores? ", vbYesNo + vbQuestion + vbDefaultButton1, "Parcelamento") = vbYes Then
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & ""
DoCmd.SetWarnings True

Else
Exit Function
End If

End If
Parcelamento Valor_Parcelar_09, Numero_Parcelas_09, Me.QdrOp

If Not Resto <= 0 Then


For i = 1 To Me.Numero_Parcelas_09

rs.AddNew
rs("Codigo") = Me.Código
rs("Nº_Documento") = i & "/" & Me.Numero_Parcelas_09
'Calcula as datas de Vencto através da função DateAdd()
rs("Vencimento") = DateAdd("m", i - 1, Me.Data_emissao)
rs("Filial") = 9


Select Case i
Case Is = 1
rs("Valor_Parcela") = ParcAjust
Case Is > 1
rs("Valor_Parcela") = ParcFix
End Select
rs.Update


Next
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & ""
DoCmd.SetWarnings True
End If
rs.Close
Set rs = Nothing

MsgBox "Valores inseridos com sucesso!!!"
End Function


Private Sub Parcelamento(Valor As Double, nParcelas As Integer, nCoefic As Integer)
Dim i As Integer

Select Case nCoefic
Case Is = 0
ParcFix = Int(Valor / nParcelas)
Case Is = 1
ParcFix = Int(Valor / nParcelas * 10) / 10
Case Is = 2
ParcFix = Int(Valor / nParcelas * 100) / 100
End Select

ParcAjust = Valor - Round((ParcFix * (nParcelas - 1)), 2)
For i = 1 To nParcelas - 1
Next i
End Sub

O que pode estar faltando para gerar as parcelas no subformulário?

Amigão, como já tem um tempo

que fiz o exemplo, não tava lembrando mais da dinâmica. Sei que o exemplo não

está documentado, mas no detalhe do formulário tem

tem quatro caixas de texto com a propriedade Visível(não), e uma delas

se chama "Resto".

É esta variável que está faltando pra você.

Veja que na função tem a variável Resto, que provém desta caixa de texto.

Coloque uma caixa de texto chamada Resto. e coloque no controle:

=SeImed([Valor_Entrada] É Nulo;nz([Total_Geral]-[Total_Geral_Desconto];0);nz(([Total_Geral]-[Total_Geral_Desconto])-[Valor_Entrada];0))

Outra maneira:

Se preferir atribuir a variável ao código coloque o código antes desta linha:

If Not Resto <= 0 Then

Dim Resto as Double
If isnull(Me.Valor_Entrada) then
Resto = nz([Total_Geral]-[Total_Geral_Desconto],0)
else
Resto = nz(([Total_Geral]-[Total_Geral_Desconto])-[Valor_Entrada],0)
end if


Sds,

Bom dia,chsestrem

Fiz as alterações que vc sugeriu, mas ainda não funcionou.
Agora no subformulario das parcelas, ele está gerando o Nº do documento e os vencimentos corretamente,porém não gera o valor das parcelas.
Analisando o Campo Resto, conclui que ele tem o mesmo valor do Campo Valor_Parcelar_09. Então no código, ao invés de Resto coloquei o Valor_Parcelar_09 e deu o mesmo resultado citado acima, ou seja, gera todos os dados, menos o valor das parcelas.
Me parece que a falha está no código que redefine os ajustes dos valores nas parcelas, pois como já disse, ele não consegue gerar esses valores.

Atualmente o código está assim:
Private Function Calc_parc()
Dim rs As DAO.Recordset, i As Byte
Dim rs1 As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("select * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & "")
Set rs1 = CurrentDb.OpenRecordset("select * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & " and quitada = -1")
If Not rs1.EOF Then
MsgBox "Esta Venda já foi parcelada e contém pagamento(s) efetuado(s). " & Chr(10) & "" _
& "Não será possível refazer o parcelamento !!!", vbCritical, "Informação"
Set rs1 = Nothing
Exit Function
End If


If Not rs.EOF Then
If MsgBox("Já existe um parcelamento para esta Venda !!! " & Chr(10) & "" _
& "Deseja substituir pelos novos valores? ", vbYesNo + vbExclamation + vbDefaultButton1, "Parcelamento") = vbYes Then
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & ""
DoCmd.SetWarnings True

Else
Exit Function
End If

End If
Parcelamento Valor_Parcelar_09, Numero_Parcelas_09, Me.QdrOp

If Not Valor_Parcelar_09 <= 0 Then


For i = 1 To Me.Numero_Parcelas_09
With rs
.AddNew
!Codigo = Me.Código
!Nº_Documento = i & "/" & Me.Numero_Parcelas_09
!Vencimento = DateAdd("m", i - 1, (Me.Data_emissao))
!Filial = 9
Select Case i
Case Is = 1
!Valor_Parcela = ParcAjust
Case Is > 1
!Valor_Parcela = ParcFix
End Select
.Update

End With
Next
Else
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * from Tbl_Vendas_Sub_Parcelas where Codigo = " & Me.Código & ""
DoCmd.SetWarnings True
End If
rs.Close
Set rs = Nothing

Me.Frm_Vendas_Sub_Parcelas.Requery
Me.Frm_Vendas_Sub_Parcelas.SetFocus
MsgBox "Valores inseridos com sucesso!!!"
End Function

E o código para ajustar as parcelas assim:


Private Sub Parcelamento(Valor As Double, nParcelas As Integer, nCoefic As Integer)
Dim i As Integer

Select Case nCoefic
Case Is = 0
ParcFix = Int(Valor / nParcelas)
Case Is = 1
ParcFix = Int(Valor / nParcelas * 10) / 10
Case Is = 2
ParcFix = Int(Valor / nParcelas * 100) / 100
End Select

ParcAjust = Valor - Round((ParcFix * (nParcelas - 1)), 2)
For i = 1 To nParcelas - 1
Next i
End Sub

Se puder me ajudar, fico mto grato.

Não grava o valor porquê você não declarou as

variáveis "ParcFix e ParcAjust" da instrução "private parcelamento"

Na declaração Geral do formulário, abaixo de

Option Compare Database, declare as variáveis

Dim ParcFix As Double, ParcAjust As Double

Tudo certo agora! Ficou ótimo! Parabéns pelo trabalho e muito obrigado pela ajuda!

Abraço