[kapetang]

Καλησπέρα

Φίλε Δημήτρη άλλαξε τον παλιό κώδικα του κουμπιού με τον:

Private Sub cmdAdd_Click()
    Dim rs As DAO.Recordset, dt As Date, i As Long, sum As Double
    Dim vPeriodos As Variant, strC As String, k As Long

    On Error GoTo errHandler
    'Ελέγχος καταχώρησης αναγκαίων στοιχείων
    If Not ((IsDate(Me.DAYEX) And _
             Nz(Me.KATIGORIAEX, "") <> "") And _
             (Nz(Me.KATASTASIEX, "") <> "") And _
             IsNumeric(Me.ARXEXODA) And _
             IsNumeric(Me.SYNDOSEON) And _
             (Nz(Me.PERIODOS, "") <> "") And _
             IsNumeric(Me.Prokatavoli)) Then
        MsgBox "Σε κάποια πεδία δε δόθηκαν κατάλληλες τιμές"
        Exit Sub
    End If

    'Αποτροπή πολλαπλών καταχωρήσεων
    strC = "DAYEX=#" & Format(Me.DAYEX, "m/d/yyyy") & "# And " & _
           "KATIGORIAEX='" & Me.KATIGORIAEX & "' And " & _
           "KATASTASIEX='" & Me.KATASTASIEX & "' AND ARXEXODA=" & _
           Replace(Me.ARXEXODA, ",", ".") & " And " & _
           "SYNDOSEON=" & Me.SYNDOSEON & " AND PERIODOS='" & Me.PERIODOS & "' And " & _
           "TREXDOSI=1 AND Prokatavoli=" & Replace(Me.Prokatavoli, ",", ".")
    If DCount("*", "tblExoda", strC) Then
        MsgBox "Τα στοιχεία είναι ήδη καταχωρημένα"
        Exit Sub
    End If

    'Καταχώρηση δεδομένων
    vPeriodos = Array(1, 2, 3, 6, 12)
    k = Me.PERIODOS.ListIndex
    Set rs = CurrentDb.OpenRecordset("tblExoda")
    dt = CDate(Me.DAYEX)
    sum = Me.Prokatavoli
    For i = 1 To Me.SYNDOSEON
        rs.AddNew
        rs!DAYEX = DateAdd("m", vPeriodos(k) * (i - 1), dt)
        If i = Me.SYNDOSEON Then
            rs!POSOEX = Me.ARXEXODA - sum
        Else
            rs!POSOEX = Round((Me.ARXEXODA - Me.Prokatavoli) / Me.SYNDOSEON, 2)
            sum = sum + Round((Me.ARXEXODA - Me.Prokatavoli) / Me.SYNDOSEON, 2)
        End If
        rs!KATIGORIAEX = Me.KATIGORIAEX
        rs!KATASTASIEX = Me.KATASTASIEX
        rs!ARXEXODA = Me.ARXEXODA
        rs!SYNDOSEON = Me.SYNDOSEON
        rs!PERIODOS = Me.PERIODOS
        rs!TREXDOSI = i
        rs!Prokatavoli = Me.Prokatavoli
        rs!PERIGRAFIEX = Me.PERIGRAFIEX
        rs.Update
    Next
    MsgBox "Η προσθήκη των εγγραφών ολοκληρώθηκε"
    Exit Sub
errHandler:
    MsgBox Err.Description, vbCritical, "Error #" & Err.Number
End Sub