التعديل على كود تكرار سجل او عمل كود جديد

[jo_2010]

الخبراء الافاضل

برجاء المساعدة

المطلوب مكتوب فى الصورة

TEST -2.rar

تم تعديل April 4 بواسطه jo_2010

[jo_2010]

الحمد للة توصلت للكود الاصلى 

الذى كتبة لى احد الخبراء الافاضل بالمنتدى

وقمت بعرضة عليكم لمن يريد الاستفادة منة

Sub DuplicateRecords()
On Error Resume Next
    Dim DB As DAO.Database
    Dim RS As DAO.Recordset
    Dim newPCode As Long
    Dim TodayDate As Date
    Dim JO_Insert_Lab As String
    Dim JO_Insert_Result As String
   
    ' فتح قاعدة البيانات الحالية
    Set DB = CurrentDb()
    TodayDate = Format(Date, "mm/dd/yyyy") ' تنسيق التاريخ بالشكل الصحيح

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

    ' استبدال المرجع بالصيغة الصحيحة
    Dim currentPCode As Long
    currentPCode = Forms!Laboratory!Lab_Request.Form!PCode
     
   
    ' إدراج السجل الجديد في Tbl_Lab_All
    JO_Insert_Lab = "INSERT INTO Tbl_Lab_All (DDate, PCode,Code_kind, Pname, Name_Month, C_Year, age,DMY, Doctor,Code_Month, Mon_Year) " & _
                   "SELECT #" & TodayDate & "#, " & newPCode & ", Code_kind,Pname, Name_Month, C_Year, age,DMY, Doctor,Code_Month, Mon_Year " & _
                   "FROM Tbl_Lab_All WHERE PCode = " & currentPCode
    DB.Execute JO_Insert_Lab

    ' إدراج السجل الجديد في Tbl_Lab_Results
    JO_Insert_Result = "INSERT INTO Tbl_Lab_Results (PCode, OK) " & _
                    "SELECT " & newPCode & ", OK " & _
                    "FROM Tbl_Lab_Results WHERE PCode IN (SELECT PCode FROM Tbl_Lab_All WHERE PCode = " & currentPCode & ")"
    DB.Execute JO_Insert_Result
      
         Me.Requery
         Me.FilterOn = False
         DoCmd.GoToRecord , , acLast
         Me.Esal.SetFocus
         Me.Esal.Locked = False

   ' MsgBox " تم  تكرار السجل بنجاح مع تحديث كود المريض و تاريخ اليوم   ", vbInformation
    '     Me.FilterOn = False
      '   DoCmd.GoToRecord , , acLast

End Sub

Private Sub Duplicate_Click()
   Select Case MsgBox("  " & " هـل  . . . . .  تـريـد  تكـرار  بيــانات  الســجل " & vbNewLine & vbCrLf & _
    " الخـاص  بــ     " & PNAME & vbNewLine & vbCrLf & vbCrLf & _
  "Yes = كــرر الســجل          No = لا تكــرر السجــل   ", vbQuestion + vbMsgBoxRight + vbYesNo, JO_Title)
                   
       Case vbYes
         DuplicateRecords
         
      Case vbNo
           DoCmd.CancelEvent
          
       End Select
     
End Sub