ERRO COM DATA - 30/02/2012

WEBIER 13/06/2012 16:37:44
#404080
pessoal, estou fazendo um sistema de parcelas... onde defino inicio e quantidade de parcelas e o sistema gera 1 registro para cada mês... sendo sequencial a data de inicio...


Private Sub Gerar_Parcelas()
    Dim var_Mes As Integer
    Dim var_Ano As Integer
    Dim var_Dia As Integer
    Dim DIA As Integer
    Dim DATA As String
    Dim i As Integer
    [ô]Dim x As Integer
    Dim PARCELA As Currency
    Dim SQL As String
    Dim n_PARC As Integer
    
    If n_PARC = 0 Then n_PARC = 1
    
    Call Abrir_BancodeDados
    SQL = [Ô]SELECT * FROM PARCELAS[Ô]
    Set RS = BD.OpenRecordset(SQL)
    
    var_Mes = Format(txtInicio, [Ô]mm[Ô])
    var_Ano = Format(txtInicio, [Ô]yy[Ô])
    
    For i = 1 To Val(txtQuant.Text)
        
        Autonumeracao_Parcelas
        
        If var_Mes > 12 Then
           var_Mes = 1
           var_Ano = var_Ano + 1
        End If
      
      var_Dia = Int(cboDiaPgto)
      
      DIA = var_Dia
      DATA = DIA & [Ô]/[Ô] & Format(var_Mes, [Ô]00[Ô]) & [Ô]/[Ô] & Format(var_Ano, [Ô]00[Ô])
      
      RS.AddNew
      RS!CODIGO = x
      RS!COD_MATRICULA = CLng(lblCodMatricula.Caption)
      RS!COD_CLIENTE = CLng(txtCodCliente.Text)
      RS!Numero = n_PARC
      RS!VENCIMENTO = Format(CDate(DATA), [Ô]dd/mm/yy[Ô])
      RS!Valor = CCur(txtParc.Text)
      RS.Update
      var_Mes = var_Mes + 1
      n_PARC = n_PARC + 1
    Next
End Sub


Public Function Verifica_Dia(DIA, var_Mes)
Dim diasDoMes As Variant
DIA = Val(DIA)
diasDoMes = Array(31, 28, 30, 30, 31, 30, 31, 30, 30, 31, 30, 31)
If DIA = 31 Then
    Verifica_Dia = diasDoMes(var_Mes - 1)
Else
    Verifica_Dia = DIA
End If
End Function


meu problema está quando defino inicio dia 30/01/2012 e mando gerar 3 parcelas... ele gera a do mês de fevereiro errado:
30/01/2012
12/02/1930
30/03/2012

como corrijo isso?
FEDERHEN 13/06/2012 17:18:44
#404084
[ô]O problema está quando a data calculada está fora do calendário, exemplo 30/02/2012.
[ô]Faça as correções em vermelho.

Private Sub Gerar_Parcelas()
Dim var_Mes As Integer
Dim var_Ano As Integer
Dim var_Dia As Integer
Dim DIA As Integer
Dim DATA As String
Dim i As Integer
[ô]Dim x As Integer
Dim PARCELA As Currency
Dim SQL As String
Dim n_PARC As Integer

If n_PARC = 0 Then n_PARC = 1

Call Abrir_BancodeDados
SQL = [Ô]SELECT * FROM PARCELAS[Ô]
Set RS = BD.OpenRecordset(SQL)

var_Mes = Format(txtInicio, [Ô]mm[Ô])
var_Ano = Format(txtInicio, [Ô]yy[Ô])

For i = 1 To Val(txtQuant.Text)

Autonumeracao_Parcelas

If var_Mes > 12 Then
var_Mes = 1
var_Ano = var_Ano + 1
End If

var_Dia = Int(cboDiaPgto)

DIA = var_Dia
DATA =[txt-color=#e80000] Verifica_Dia(var_Dia, var_Mes) [/txt-color]& [Ô]/[Ô] & Format(var_Mes, [Ô]00[Ô]) & [Ô]/[Ô] & Format(var_Ano, [Ô]00[Ô])

RS.AddNew
RS!CODIGO = x
RS!COD_MATRICULA = CLng(lblCodMatricula.Caption)
RS!COD_CLIENTE = CLng(txtCodCliente.Text)
RS!Numero = n_PARC
RS!VENCIMENTO = Format(CDate(DATA), [Ô]dd/mm/yy[Ô])
RS!Valor = CCur(txtParc.Text)
RS.Update
var_Mes = var_Mes + 1
n_PARC = n_PARC + 1
Next
End Sub


Public Function Verifica_Dia(DIA, var_Mes)
Dim diasDoMes As Variant
DIA = Val(DIA)
diasDoMes = Array(31, 28, 30, 30, 31, 30, 31, 30, 30, 31, 30, 31)
[txt-color=#e80000][ô]If DIA = 31 Then
If DIA > diasDoMes(var_Mes - 1) Then[/txt-color]
Verifica_Dia = diasDoMes(var_Mes - 1)
Else
Verifica_Dia = DIA
End If
End Function
MARCELO.TREZE 13/06/2012 22:05:53
#404096 Resposta escolhida
olha colega como é simples

Private Sub Command1_Click()
GeraParcelas [Ô]30/01/2012[Ô], 3
End Sub


Function GeraParcelas(DataIni As Date, quant As Integer)
List1.Clear
DataIni = DateAdd([Ô]m[Ô], -1, DataIni)
For P = 1 To quant
List1.AddItem P & [Ô] - [Ô] & DateAdd([Ô]m[Ô], P, DataIni)
Next P
End Function



veja o código acima a simplicidade é formidável, no caso usei apenas o DateAdd, no exemplo acima exibo as parcelas em um listbox

se você fizer o teste verá que as parcelas serão exibidas corretamente
MARCELO.TREZE 13/06/2012 22:35:05
#404098
Se te interessar, veja a modificação sugerida para seu projeto

Private Sub Gerar_Parcelas()
   
    Dim i As Integer
    Dim SQL As String
    Dim DataIni As Date
    Dim QuantParcelas As Integer
    
    DataIni = CDate(txtInicio.Text)
    QuantParcelas = CInt(txtQuant.Text)

    Call Abrir_BancodeDados
    SQL = [Ô]SELECT * FROM PARCELAS[Ô]
    Set RS = BD.OpenRecordset(SQL)
    DataIni = DateAdd([Ô]m[Ô], -1,DataIni)
    For i = 1 To QuantParcelas
      RS.AddNew
      RS!CODIGO = x
      RS!COD_MATRICULA = CLng(lblCodMatricula.Caption)
      RS!COD_CLIENTE = CLng(txtCodCliente.Text)
      RS!Numero = i
      RS!VENCIMENTO = Format(DateAdd([Ô]m[Ô], i, DataIni), [Ô]dd/mm/yy[Ô])
      RS!Valor = CCur(txtParc.Text)
      RS.Update
     Next i
End Sub


bom não sei se funcionara faça os testes
CASTELO 13/06/2012 23:13:00
#404099
Citação:

:
olha colega como é simples

Private Sub Command1_Click()
GeraParcelas [Ô]30/01/2012[Ô], 3
End Sub


Function GeraParcelas(DataIni As Date, quant As Integer)
List1.Clear
DataIni = DateAdd([Ô]m[Ô], -1, DataIni)
For P = 1 To quant
List1.AddItem P & [Ô] - [Ô] & DateAdd([Ô]m[Ô], P, DataIni)
Next P
End Function



veja o código acima a simplicidade é formidável, no caso usei apenas o DateAdd, no exemplo acima exibo as parcelas em um listbox

se você fizer o teste verá que as parcelas serão exibidas corretamente




Muito bom o exemplo marcelo.
Tópico encerrado , respostas não são mais permitidas
Voltar