
19-10-24, 21:18
|
 | Διαχειριστής Όνομα: Τάσος Φιλοξενιδης Έκδοση λογισμικού Office: Ms-Office 365 Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική | | Εγγραφή: 21-10-2009
Μηνύματα: 2.035
| |
Καλησπέρα σε όλους!
Δημήτρη δοκίμασε τον παρακάτω κώδικα: Κώδικας: Option Compare Database
Option Explicit
Private Sub Cmd2_Click()
Dim db As DAO.Database
Dim strSQL As String
Dim strSP7 As String
Dim i As Long
Dim IntYear As Integer
Dim IntMonth As Integer
Dim StartDate As Date
Dim EndDate As Date
If Nz(Me.dtDate, 0) < 1 Then Exit Sub
If Trim(Nz(Me.SP7, "")) = "" Then Exit Sub
Set db = CurrentDb
IntYear = Year(Me.dtDate)
IntMonth = Month(Me.dtDate)
StartDate = DateSerial(IntYear, IntMonth, 1)
EndDate = DateSerial(IntYear, IntMonth + 1, 0)
strSP7 = Me.SP7
'------------------------------------------------------------------------------------------------------
'Διαγραφή εγγραφών με ημερομηνία του επιλεγμένου έτους και μήνα αν ήδη έχουν καταχωρηθεί στον πίνακα
'strSQL = "DELETE * FROM HmeresMina WHERE YEAR(Hmera) = " & IntYear & " AND MONTH(Hmera) = " & IntMonth
'db.Execute strSQL
'------------------------------------------------------------------------------------------------------
For i = StartDate To EndDate
If Weekday(i, vbMonday) < 6 Then
db.Execute "Insert Into HmeresMina ( Hmera, Meso ) VALUES ( #" & _
Format(i, "M\/d\/yyyy") & "#, '" & strSP7 & "' )"
End If
Next
Me.subfrmHmeresMina.Form.Requery
Set db = Nothing
End Sub
Για να τρέξει ο κώδικας θα χρειαστεί να μετονομάσεις στη φόρμα τα εξής:
Πεδίο ημερομηνίας σε "dtDate"
Υποφόρμα (Θυγατρική3) σε "subfrmHmeresMina"
Καλή συνέχεια.
Τάσος
__________________ Ms-Office Development Team Ανάπτυξη επαγγελματικών εφαρμογών |