Εμφάνιση ενός μόνο μηνύματος
  #2  
Παλιά 19-10-24, 21:18
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού 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
Ανάπτυξη επαγγελματικών εφαρμογών
Απάντηση με παράθεση