GERAR PARCELA

dim iVarFor as integer

for iVarFor 0 1 to Quantidade
    dataParcela = dateadd("M",1,"data inicial de suas parcela)
    aqui vc coloca sua função de gravar
next

Public Sub CalculaParcela(vPrincipal As Double, vEntrada As Double, vJurosAM As Double, vDescontos As Double, qParcelas As Double, iList As OsenXPListBox)
    Dim F(0 To 1) As Double, iCalculo As Double, i As Integer, pRin As Double, pJur As Double
    pRin = CDbl(vPrincipal - vEntrada)
    pJur = CDbl(vJurosAM - vDescontos)
    pJur = pJur / 100
    iCalculo = Abs(-Pmt(pJur, qParcelas, pRin, 0))
    For i = 1 To Int(qParcelas)
        F(0) = PPmt(pJur, i, qParcelas, -pRin, 0, 0)
        F(0) = ((F(0) + 0.005) * 100) / 100
        F(1) = iCalculo - F(0)
        F(1) = ((F(1) + 0.005) * 100) / 100
        iList.AddItem Format(i, "00") & vbTab & _
                      Format(DateAdd("m", i, Date), "DD/MM/YYYY") & _
                      vbTab & Format(iCalculo, "#,###,###,##0.00") & _
                      vbTab & Format(F(0), "#,###,###,##0.00") & _
                      vbTab & Format(F(1), "#,###,###,##0.00")
    Next
End Sub

Private Sub Command1_Click()
'1000 = PRINCIAPL
'0 = ENTRADA
'12 = JUROS AO MÃÅ S
'0 = DESCONTOS
'6 = QUANTIDADE DE PARCELAS
    Call CalculaParcela(1000, 0, 12, 0, 6, XPListBox)
End Sub

Private Sub cmdcadastrar_Click()
If MsgBox("Deseja incluir um novo Cliente ? ", vbYesNo, "Buscar Cliente") = vbYes Then
frmcadclientes.Show vbModal
Else
Exit Sub
End If
End Sub

Private Sub Form_Load()

On Error GoTo trata_erro

Set db = OpenDatabase(App.Path & "\vendas.mdb")
Set clientes = db.OpenRecordset("clientes")
Set parcelas = db.OpenRecordset("parcelas")

Data1.DatabaseName = App.Path & "\vendas.mdb"
Data1.RecordSource = "clientes"
Data2.DatabaseName = App.Path & "\vendas.mdb"
Data2.RecordSource = "parcelas"

DBGrid1.Columns(0).Visible = False
DBGrid1.Columns(1).Visible = False
DBGrid1.Columns(4).Visible = True

Exit Sub

trata_erro:
   If Err.Number = 3261 Then
       MsgBox " Erro : " & Err.Number & " : a tabela esta bloqueada . Verifique ! ", vbCritical, "Dados bloqueados"
   Else
       MsgBox Err.Number & " - " & Err.Description
   End If
End Sub

Private Sub cmdgeramensalidades_Click()
Dim mes As Integer
Dim ano As Integer
Dim data As String

mes = Format(Now, "mm")
ano = Format(Now, "yy")

For i = 1 To Val(txtnumeroparcelas.Text)
    mes = mes + 1
    If mes > 12 Then
       mes = 1
       ano = ano + 1
   End If
  dia1 = Format(Now, "dd")
  dia = Verifica_dia(dia1, mes)
  data = dia & "/" & Format(mes, "00") & "/" & Format(ano, "00")
  parcela = CCur(txtvalor.Text) / Val(txtnumeroparcelas.Text)
  Data2.Recordset.AddNew
  Data2.Recordset.Fields(1) = CLng(txtcodigo.Text)
  Data2.Recordset.Fields(2) = Format(CDate(data), "dd/mm/yy")
  Data2.Recordset.Fields(3) = CCur(parcela)
  Data2.Recordset.Fields(4) = False
  Data2.Recordset.Update
Next
End Sub

Private Sub Data1_Reposition()
If txtcodigo.Text <> "" Then
Data2.RecordSource = "Select * from parcelas where codigo= " & CLng(txtcodigo.Text)
Data2.Refresh
End If
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)

  'Esse código permite a mudança de quadro de texto através do Enter
  If KeyAscii = 13 Then
     'Se o tipo do controle ativo for TextBox
     If TypeOf Screen.ActiveControl Is TextBox Then
       'Simula o pressionamento da tecla TAB
        SendKeys "{tab}"
       'A linha a seguir evita ouvir um bip
       KeyAscii = 0
    End If
End If
End Sub

Public Function Verifica_dia(dia, 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(mes - 1)
Else
Verifica_dia = dia
End If

End Function