نجوم المشاركات

الحمد للة توصلت للكود الاصلى الذى كتبة لى احد الخبراء الافاضل بالمنتدى وقمت بعرضة عليكم لمن يريد الاستفادة منة 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

من رخصة الاستاذ منتصر وهذه مشاركة اخرى قد تستفيد منها اخي الكريم 444.accdb

شكرا يا عسل العسل ليس قليل الدسم ... العسل كله حلا

شكراً لك ، ولكني لا أثق بالذكاء الإصطناعي ومقترحاته 😇 .

تمام ... فعلا هو المطلوب وبارك الله فيك

الاصدار الجديد نزولا على راى أخى : أحمد ساري استخدام عنوان الحقل للعرض وان لم يكن موجود يتم استخدام اسم الحقل UniversalSearch Pro v2.02.accdb.zip

تم عمل بعض التعديلات عمي جعفر .. مع التنويه إلى أن هذه الأداة لاتقوم بكتابة الأكواد بناءً على الطلبات ! بل وظيفتها تعديل وتحسين الكود الذي تعطيها إياه وتصحيح الأخطاء الموجودة فيه بالإضافة للخدمات الأخرى : ولتحقيق مرونة أكبر للمستخدم ، أضفت حقل خاص بكتابة تعليمات مخصصة توجهها للذكاء الاصطناعي بحيث يراعيها عند معالجة الطلب ، مثال : ( قم بتغيير أسماء المتغيرات لأسماء مقروءة ، أو قم تقسيم جملة SQL لعدة أسطر هكذا ....... ، أو ، أو ) أكتب ما شئت 🙂 وبعد التجربة على الجملة التي أوردتها : strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " & vbCrLf & _ "FROM tblCheckINOut " & vbCrLf & _ "WHERE (((tblCheckINOut.EmpUser)='" & EmpUserid & "')) " & vbCrLf & _ "ORDER BY tblCheckINOut.id DESC;" كانت النتيجة : Option Explicit Dim strSql As String strSql = "SELECT TOP 1 tblCheckINOut.id, tblCheckINOut.EmpUser, tblCheckINOut.chekInOut, tblCheckINOut.chkio, tblCheckINOut.ftra_id " strSql = strSql & "FROM tblCheckINOut " strSql = strSql & "WHERE (((tblCheckINOut.EmpUser)='" & EmpUserid & "')) " strSql = strSql & "ORDER BY tblCheckINOut.id DESC;" وكانت هذه هي التعليمات الإضافية : قم بتقسيم جملة SQL لعدة أسطر بهذا الأسلوب : strSql = strSql & " "