Forum

Forum (https://www.ms-office.gr/forum/)
-   Access - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/)
-   -   [ Πίνακες ] Προσθήκη ημέρων μήνα σε πίνακα χωρίς τα ΣΚ (https://www.ms-office.gr/forum/access-erotiseis-apantiseis/6569-prosthiki-imeron-mina-se-pinaka-xoris-ta-sk.html)

dimitris p 19-10-24 13:51

Προσθήκη ημέρων μήνα σε πίνακα χωρίς τα ΣΚ
 
1 Συνημμένο(α)
Καλησπέρα σε όλους τους φίλους τoυ φόρουμ.

Αυτό που θα ήθελα είναι επιλέγοντας μια ημερομηνία και στη συνέχεια κάνοντας κλικ στο [Προσθήκη ημερών] να
καταχωρούνται στον πίνακα HmeresMina οι ημέρες του επιλεγμένου μήνα αλλά χωρίς τα Σαβατοκύριακα καθώς
και το μέσο που έχει επιλεγεί.
Δηλ αν ο μήνας είναι πχ ο Σεπτέμβριος του 2024 τότε να προσθέτονται οι ημέρες από 1/9/24 έως τέλος του μήνα χωρίς τα ΣΚ.

Ευχαριστώ πολύ.

Tasos 19-10-24 21:18

Καλησπέρα σε όλους!

Δημήτρη δοκίμασε τον παρακάτω κώδικα:

Κώδικας:

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"

Καλή συνέχεια.

Τάσος

dimitris p 19-10-24 23:54

Καλημέρα και καλή Κυριακή σε όλους.
Τάσο ευχαριστώ πολύ για την λύση, είναι τέλειο (όπως πάντα), λειτούργησε μια χαρά.
Ευχαριστώ όλους που κατα καιρούς με βοήθησαν.
Καλό βράδυ.


Η ώρα είναι 05:11.

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2