Parcelador: Ao gerar parcelas, o total de parcelas gerado fica diferente do valor da venda
Software: SOFTSHOP | Grupo: SOFTSHOP | Prioridade: ALTA
Solução
Causa:
Diferença de centavos ocasionada porque o módulo está dividindo as parcelas com valores iguais, porém a úiltima parcela deveria ficar com o valor restante da venda
Solução:
Trocar o código do gerador de parcelas para o código abaixo, ele fica no modulo "Acoes_Vendas": 'INICIO DO PARCELADOR NOVO ----------------------------- Public Sub Parcelador_GerarPagamentos() On Error GoTo Ex If (frmVendas.AllowEdits) Then DoCmd.RunCommand acCmdSaveRecord Dim rsBloquetes As Recordset Dim TotalDoPedido As Double Dim ValorDaEntrada As Double TotalDoPedido = Nz(frmVendas.Controls("tot"), 0) 'VALIDACAO --------------- If (frmVendas.Controls("codVenda") = 0) Then MsgBox "Nenhum pedido selecionado.", vbExclamation, "Aviso" Exit Sub End If If (frmVendas.Controls("FormaParcelado") Like "DUPLICATA*") Or _ (frmVendas.Controls("FormaParcelado") Like "CHEQUE*") Or _ (frmVendas.Controls("ParceladorCondicao").Column(2) Like "DUPLICATA*") Or _ (frmVendas.Controls("ParceladorCondicao").Column(2) Like "CHEQUE*") Then If (IsNull(frmVendas.Controls("Nome do Cliente")) Or (frmVendas.Controls("Nome do Cliente") = 1)) Then MsgBox "Um cliente deve ser informado.", vbExclamation, "Aviso" frmVendas.Controls("Nome do Cliente").SetFocus Exit Sub End If End If '------------------------- 'DELETANDO BLOQUETES ATUAL CurrentDb.Execute "DELETE * FROM [Bloquetes] WHERE [Código da Venda] = " & frmVendas.Controls("codVenda"), dbSeeChanges frmVendas.Controls("subformulário bloquetes2").Requery Set rsBloquetes = CurrentDb.OpenRecordset("Bloquetes", dbOpenDynaset, dbSeeChanges) 'INICIO ENTRADA ----- If (frmVendas.Controls("ParceladorDefinirEntrada")) Then 'Validacao ----- If (IsNull(frmVendas.Controls("FormaEntrada"))) Then MsgBox "A forma de pagamento da entrada deve ser informada.", vbExclamation, "Aviso" frmVendas.Controls("FormaEntrada").SetFocus Exit Sub End If If ((frmVendas.Controls("FormaEntrada") = "CARTÃO") And (IsNull(frmVendas.Controls("TipoCartãoEntrada")))) Then MsgBox "O cartão da forma de pagamento da entrada deve ser informado.", vbExclamation, "Aviso" frmVendas.Controls("TipoCartãoEntrada").SetFocus Exit Sub End If If ((IsNull(frmVendas.Controls("ValorEntrada"))) Or (frmVendas.Controls("ValorEntrada") <= 0)) Then MsgBox "O valor da forma de pagamento da entrada deve ser informado.", vbExclamation, "Aviso" frmVendas.Controls("ValorEntrada").SetFocus Exit Sub End If If (frmVendas.Controls("ValorEntrada") > TotalDoPedido) Then MsgBox "O valor da entrada não pode ser maior que o valor do pedido.", vbExclamation, "Aviso" frmVendas.Controls("ValorEntrada").SetFocus Exit Sub End If '--------------- ValorDaEntrada = Nz(frmVendas.Controls("ValorEntrada"), 0) 'ADICIONANDO ENTRADA rsBloquetes.AddNew rsBloquetes("Código da Venda") = frmVendas.Controls("codVenda") rsBloquetes("Pagto") = frmVendas.Controls("FormaEntrada") rsBloquetes("Banco") = frmVendas.Controls("TipoCartãoEntrada") rsBloquetes("Valor da Parcela") = ValorDaEntrada rsBloquetes("Bloquete") = frmVendas.Controls("codVenda") rsBloquetes("Vencimento") = IIf(frmVendas.Controls("FormaEntrada") = "CARTÃO", Util_getDataUtil(frmVendas.Controls("Data da Venda"), Nz(frmVendas.Controls("TipoCartãoEntrada").Column(1), 0)), Date) rsBloquetes("Parcelas") = 1 rsBloquetes.Update '------------------- End If 'FIM ENTRADA ----------- 'INICIO PARCELADOR AVULSO ----- If (frmVendas.Controls("ParceladorTipoCondicao") = 0) Then 'Validacao ----- If (IsNull(frmVendas.Controls("FormaParcelado"))) Then MsgBox "A forma de pagamento deve ser informada.", vbExclamation, "Aviso" frmVendas.Controls("FormaParcelado").SetFocus Exit Sub End If If ((frmVendas.Controls("FormaParcelado") = "CARTÃO") And (IsNull(frmVendas.Controls("TipoCartãoParcelado")))) Then MsgBox "O cartão da forma de pagamento deve ser informado.", vbExclamation, "Aviso" frmVendas.Controls("TipoCartãoParcelado").SetFocus Exit Sub End If If ((IsNull(frmVendas.Controls("Parcelado"))) Or (frmVendas.Controls("Parcelado") <= 0)) Then MsgBox "As parcelas devem ser informadas.", vbExclamation, "Aviso" frmVendas.Controls("Parcelado").SetFocus Exit Sub End If If (((frmVendas.Controls("FormaParcelado") <> "CARTÃO") And (frmVendas.Controls("FormaParcelado") <> "FINANCEIRA")) And (IsNull(frmVendas.Controls("DataPrimeiraParcela")))) Then MsgBox "Para essa forma de pagamento a data do 1º vencimento deve ser informada.", vbExclamation, "Aviso" frmVendas.Controls("DataPrimeiraParcela").SetFocus Exit Sub End If If (((frmVendas.Controls("FormaParcelado") <> "CARTÃO") And (frmVendas.Controls("FormaParcelado") <> "FINANCEIRA")) And (frmVendas.Controls("DataPrimeiraParcela") < frmVendas.Controls("Data da Venda"))) Then MsgBox "A data do 1º vencimento não pode ser inferior a data do pedido.", vbExclamation, "Aviso" frmVendas.Controls("DataPrimeiraParcela").SetFocus Exit Sub End If If (((frmVendas.Controls("FormaParcelado") <> "CARTÃO") And (frmVendas.Controls("FormaParcelado") <> "FINANCEIRA")) And (frmVendas.Controls("ParceladorDias") <= 0)) Then MsgBox "Para essa forma de pagamento o intervalo de dias deve informado.", vbExclamation, "Aviso" frmVendas.Controls("ParceladorDias").SetFocus Exit Sub End If '--------------- 'VERIFICANDO FORMA DE PAGAMENTO If ((frmVendas.Controls("FormaParcelado") = "CARTÃO") Or (frmVendas.Controls("FormaParcelado") = "FINANCEIRA")) Then 'ADICIONANDO CARTAO OU FINANCEIRA rsBloquetes.AddNew rsBloquetes("Código da Venda") = frmVendas.Controls("codVenda") rsBloquetes("Pagto") = frmVendas.Controls("FormaParcelado") rsBloquetes("Banco") = frmVendas.Controls("TipoCartãoParcelado") rsBloquetes("Valor da Parcela") = Format(TotalDoPedido - ValorDaEntrada, "#.00") rsBloquetes("Bloquete") = frmVendas.Controls("codVenda") rsBloquetes("Parcelas") = frmVendas.Controls("Parcelado") rsBloquetes.Update '------------------------------- Else 'ADICIONANDO PARCELAS Dim DataParcial As Date Dim xx As Integer Dim TotalPagamentos As Double Dim rsPagamentos As Recordset For xx = 1 To frmVendas.Controls("Parcelado") DataParcial = IIf(xx = 1, frmVendas.Controls("DataPrimeiraParcela"), Util_getDataUtil(frmVendas.Controls("DataPrimeiraParcela"), Nz(frmVendas.Controls("ParceladorDias"), 30) * (xx - 1))) rsBloquetes.AddNew rsBloquetes("Código da Venda") = frmVendas.Controls("codVenda") rsBloquetes("Pagto") = frmVendas.Controls("FormaParcelado") rsBloquetes("Banco") = frmVendas.Controls("TipoCartãoParcelado") 'Lançando resto na ultima parcela para evitar diferença de centavos If xx = frmVendas.Controls("Parcelado") Then Set rsPagamentos = CurrentDb.OpenRecordset("SELECT Sum(Bloquetes.[Valor da Parcela]) AS [TotalPagamento] FROM Bloquetes WHERE [Código da Venda] = " & frmVendas.Controls("codVenda"), dbOpenDynaset, dbSeeChanges) TotalPagamentos = rsPagamentos("TotalPagamento") rsBloquetes("Valor da Parcela") = Format(TotalDoPedido - TotalPagamentos, "#.00") Else rsBloquetes("Valor da Parcela") = Format((TotalDoPedido - ValorDaEntrada) / frmVendas.Controls("Parcelado"), "#.00") End If rsBloquetes("Bloquete") = frmVendas.Controls("codVenda") rsBloquetes("Vencimento") = DataParcial rsBloquetes("Parcelas") = xx + IIf(frmVendas.Controls("ParceladorDefinirEntrada"), 1, 0) rsBloquetes("Prazo") = DateDiff("d", frmVendas.Controls("Data da Venda"), DataParcial) rsBloquetes.Update Next xx '----------------------- End If End If 'FIM PARCELADOR AVULSO -------- 'INICIO CONDICAO PREDEFINIDA ----- If (frmVendas.Controls("ParceladorTipoCondicao") = 1) Then 'Validacao ----- If (IsNull(frmVendas.Controls("ParceladorCondicao"))) Then MsgBox "A condição deve ser informada.", vbExclamation, "Aviso" frmVendas.Controls("ParceladorCondicao").SetFocus Exit Sub End If '---------------- Dim CondicoesParcelas As Integer Dim rsParcelas As Recordset CondicoesParcelas = Util_DContar("ParceladorSub", "[ID_Parcelador] = " & Nz(frmVendas.Controls("ParceladorCondicao"), 0)) Set rsParcelas = CurrentDb.OpenRecordset("SELECT * FROM [ParceladorSub] WHERE [ID_Parcelador] = " & Nz(frmVendas.Controls("ParceladorCondicao"), 0), dbOpenDynaset, dbSeeChanges) xx = 1 Do While Not rsParcelas.EOF DataParcial = Util_getDataUtil(frmVendas.Controls("Data da Venda"), rsParcelas("PrazoDias")) rsBloquetes.AddNew rsBloquetes("Código da Venda") = frmVendas.Controls("codVenda") rsBloquetes("Pagto") = frmVendas.Controls("ParceladorCondicao").Column(2) rsBloquetes("Valor da Parcela") = Format((TotalDoPedido - ValorDaEntrada) / CondicoesParcelas, "#.00") rsBloquetes("Bloquete") = frmVendas.Controls("codVenda") rsBloquetes("Vencimento") = DataParcial rsBloquetes("Parcelas") = xx + IIf(frmVendas.Controls("ParceladorDefinirEntrada"), 1, 0) rsBloquetes("Prazo") = DateDiff("d", frmVendas.Controls("Data da Venda"), DataParcial) rsBloquetes.Update xx = xx + 1 rsParcelas.MoveNext Loop End If 'FIM CONDICAO PREDEFINIDA -------- frmVendas.Controls("subformulário bloquetes2").Requery DoCmd.RunMacro "Vendas.GerarReceber" Exit Sub Ex: MsgBox "Erro no método Parcelador_GerarPagamentos: " & Err.Description, vbCritical, "Aviso" Err.Clear End Sub
Tags: parcelador, parcelador venda, salvar venda