تعديل على كود لضبط فورمات التاريخ

[jo_2010]

السادة الخبراء الافاضل

بعد التحية

Sub DuplicateRecords()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim newPCode As Long
    Dim todayDate As Date
    Dim sqlInsertLab As String
    Dim sqlInsertRequest As String
    Dim sqlInsertTests As String

    ' فتح قاعدة البيانات الحالية
    Set db = CurrentDb()
    todayDate = Date         (اريد التعديل على التاريخ ليعطى تاريخ اليوم لانة يعطى يعكس الشهر مكان اليوم)

    ' جلب آخر PCode من جدول tbl_NewLab لتجنب التكرار
    Set rs = db.OpenRecordset("SELECT MAX(PCode) AS MaxPCode FROM tbl_NewLab")
    If Not rs.EOF Then
        newPCode = rs!MaxPCode + 1
    Else
        newPCode = 1 ' في حالة عدم وجود سجلات
    End If
    rs.Close

    ' استبدال المرجع بالصيغة الصحيحة
    Dim currentPCode As Long
    currentPCode = Forms!New_Project!newRequest.Form!PCode

    ' إدراج السجل الجديد في tbl_NewLab
    sqlInsertLab = "INSERT INTO tbl_NewLab (DDate, PCode, Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year) " & _
                   "SELECT #" & todayDate & "#, " & newPCode & ", Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year " & _
                   "FROM tbl_NewLab WHERE PCode = " & currentPCode
    db.Execute sqlInsertLab

    ' إدراج السجل الجديد في tbl_NewRequest
    sqlInsertRequest = "INSERT INTO tbl_NewRequest (PCode, TCode, Date_R, Price_R, Tname_R) " & _
                       "SELECT " & newPCode & ", TCode, #" & todayDate & "#, Price_R, Tname_R " & _
                       "FROM tbl_NewRequest WHERE PCode = " & currentPCode
    db.Execute sqlInsertRequest

    ' إدراج السجل الجديد في tbl_NewTests (إذا لزم الأمر)
    sqlInsertTests = "INSERT INTO tbl_NewTests (TCode, TName, Price) " & _
                     "SELECT TCode, TName, Price " & _
                     "FROM tbl_NewTests WHERE TCode IN (SELECT TCode FROM tbl_NewRequest WHERE PCode = " & currentPCode & ")"
    db.Execute sqlInsertTests

    MsgBox "تم تكرار السجل بنجاح مع تحديث PCode والتاريخ.", vbInformation
End Sub


Private Sub أمر4030_Click()
   DuplicateRecords
End Sub

هذا الكود من المبدع الخبير الفاضل   ابو جودي

ولكن فى التاريخ بدل من 6 فبراير2025       يعطى 2 يونيو 2025  يستبدل اليوم بالشهر ارجو تعديل الكود

[Foksh]

المشكلة اللي بتحصل عندك سببها أن التاريخ الذي يتم إدخاله في قاعدة البيانات يتم تفسيره بشكل خاطئ بسبب اختلاف تنسيق التاريخ بين التنسيق (الشهر/اليوم/السنة) والتنسيق الذي تستخدمه (اليوم/الشهر/السنة) . 

ولحل هذه المشكلة تقدر تستخدم الدالة Format لتنسيق التاريخ بالطريقة الصحيحة التي تفهمها قاعدة البيانات عندك . فاقترح تعديل الكود لاستخدام Format لضمان أن التاريخ يتم إدخاله بالشكل الصحيح .

جرب التعديل التالي ..

Sub DuplicateRecords()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim newPCode As Long
    Dim todayDate As String
    Dim sqlInsertLab As String
    Dim sqlInsertRequest As String
    Dim sqlInsertTests As String

    ' فتح قاعدة البيانات الحالية
    Set db = CurrentDb()
    todayDate = Format(Date, "mm/dd/yyyy") ' تنسيق التاريخ بالشكل الصحيح

    ' جلب آخر PCode من جدول tbl_NewLab لتجنب التكرار
    Set rs = db.OpenRecordset("SELECT MAX(PCode) AS MaxPCode FROM tbl_NewLab")
    If Not rs.EOF Then
        newPCode = rs!MaxPCode + 1
    Else
        newPCode = 1 ' في حالة عدم وجود سجلات
    End If
    rs.Close

    ' استبدال المرجع بالصيغة الصحيحة
    Dim currentPCode As Long
    currentPCode = Forms!New_Project!newRequest.Form!PCode

    ' إدراج السجل الجديد في tbl_NewLab
    sqlInsertLab = "INSERT INTO tbl_NewLab (DDate, PCode, Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year) " & _
                   "SELECT #" & todayDate & "#, " & newPCode & ", Pname, Name_Month, C_Year, Area, Code_Month, Mon_Year " & _
                   "FROM tbl_NewLab WHERE PCode = " & currentPCode
    db.Execute sqlInsertLab

    ' إدراج السجل الجديد في tbl_NewRequest
    sqlInsertRequest = "INSERT INTO tbl_NewRequest (PCode, TCode, Date_R, Price_R, Tname_R) " & _
                       "SELECT " & newPCode & ", TCode, #" & todayDate & "#, Price_R, Tname_R " & _
                       "FROM tbl_NewRequest WHERE PCode = " & currentPCode
    db.Execute sqlInsertRequest

    ' إدراج السجل الجديد في tbl_NewTests (إذا لزم الأمر)
    sqlInsertTests = "INSERT INTO tbl_NewTests (TCode, TName, Price) " & _
                     "SELECT TCode, TName, Price " & _
                     "FROM tbl_NewTests WHERE TCode IN (SELECT TCode FROM tbl_NewRequest WHERE PCode = " & currentPCode & ")"
    db.Execute sqlInsertTests

    MsgBox "تم تكرار السجل بنجاح مع تحديث PCode والتاريخ.", vbInformation
End Sub


Private Sub أمر4030_Click()
   DuplicateRecords
End Sub

 

او انك تعيد تنسيق التاريخ في كمبيوترك لما يتناسب مع المطلوب تحقيقه ..

تم تعديل فبراير 6 بواسطه Foksh