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

الخبراء الافاضل برجاء المساعدة المطلوب مكتوب فى الصورة TEST -2.rar

شكرا علي ابداء رايك

معلمى الفاضل توصلت لحل متواضع اريد عرضة على حضرتك افتح القاعدة الجديدة واتفرج عليها واذا كان هناك تعديل من حضرتك لتصبح افضل مما هى علية قم بالتعديل على النموذج ولك الشكر وافينى برايك لان مهم عندى جدا JO_Lab.rar

الحمدللة الخبير الفاضل منتصر الانسى لة خالص الشكر اضاف select case الى البرنامج الخاض بة واعطى نتائج رائعة

معلمى الفاضل انظر الصور

الخبير المبدع الذى اتابع كل اعمالة واتعلم منها خالص الشكر لسرعة الاستجابة وإضافة Select Case للبرنامج شكرررررررررا

شكرا يا معلمى الفاضل كثر خيرك ساجرب واوافيك بالنتيجة سؤال هل لو تم تحويل النموذج إلى نموذج مفرد بدل من النماذج المستمرة يثاثر البرنامج ام لا

الخبير الفاضل foksh الذى لايبخل بعلمة علي احد اشكرك علي اهتمامك ولكني وجدت نمودج فى منتدانا الغالى من إبداع الخبير الفاضل منتصر الانسى لتوليد الرسالة بسهولة والكود مصمم بقاعدة if هذا هو اصرارى علي استخدام قاعدة If لان النموذج تم تصميمة بقاعدة If تستطيع الاطلاع علي النموذج الخاص بعمل كود الرسالة من إبداعات منتصر الانسي

الخبير الفاضل شكرا لابداعك المتجددة لي طلب بسيط ممكن لو تكرمت تستبدل قاعدة If بقاعدة Select Case حتى نتمكن من عمل امر لكل زر فى الرسالة مثلا لو حددنا ٣ ازرار نعم ولا وإلغاء الامر نعم فتح نموذج محدد لا لفتح تقرير محدد الغاء الأمر لغلق الرسالة لانى قمت بتجربة هذا الموضوع نعم يفتح النموذج تمام لا يفتح التقرير تمام الغاء الأمر حاولت بكل الطرق Undo Exit Sub لكنة يكرر الأمر السابق وهو فتح التقرير لذلك ارجوك تحويل قاعدة If إل cselect case لك خالص الشكر

قمت بمسح السطر واعطى الاتى انظر الصورة

الخبير المبدع شكرا على ابداعك بس حضرتك انا كنت عاوز تعطيل فقط على الكود وهو بنفس الشكل بدون متغيرات كنت كيبت الكلام دة قبل كدة مفيش اى تعديل علي الكود المرسل بدون إضافة Dim result as بدون متغيرات لان الرسالة دى بيتم توليدها من برنامج وجدتي علي الموقع ولا أستطيع التعديل علية انا بكتب عنوان الرسالة ومستواها وعدد الازرار وهو بينتج الكود اريد التعديل علي الكود كما هو هل هذا ممكن البرنامج موجود فى هذا الرابط

انظر الصور

استاذى الفاضل قمت بتغيير Undo الى Exit Sub واعطى نفس النتيجة السابقة وهو تنفيذ اخر امر فتح التقرير اليك القاعدة للتعديل JO.accdb

قمت بتجربة النموذج المرسل من حضرتك يعمل بكفاءة مع الايصالات التى تنتهى ب ٥٥ وعندما كتبت ١٠٠٠ أصبحت القيمة ٥٦٠٠٠ وهذا رائع وقمت بإدخال رقم الإيصال ه أرقام ٥٦٠٠١ ورقم آخر ٠٠٩ أعطى نتيجة رائعة ولكن حاولت تجربة إذا تخطينا ٥٦ بدل رقمين أصبحت ٣ أرقام مثال١٠١٠٠٥ أدخلت رقم إيصال بالكامل ١٠١٠١٩ وسجل جديد كتبت ١٢٢ لم يحتفظ ١٠١ وعاد الي ٥٦ أصبح الإيصال ٥٦١٢٢ بدل ١٠١١٢٢ وهو الرقم الصحيح كيفية حل هذا الوضع هذا الخطأ يظهر لى كثيرا كتبت إيصال ٢٣٠ المفروض ٥٦٢٣٠ قبل منة كان في إيصال ٥٦٢٥٠ يعطى خطا كما بالصورة