kanory

للتعلم ... اعمل استعلام تحديث للجدول وقم بعمل معيار bitween ....

الشرح :::: تنسيق شرطي في جميع طلباتك اخي الكريم انظر الصورة ..... تفضل المرفق بعد التعديل <<<<<<<<>>>>>>>> DATA1041.mdb

تفضل <<<<<<<<>>>>>>>>> DATA1041.mdb

استخدم هذا الكود في مربع النص الخاص بالتاريخ في حدث بعد التحديث ...... If Not IsNull(DLookup("A", "ABCD", "C=form!C and D=form!D And A=form!A And A=form!A")) Then If MsgBox("سبق إدخال " & C & " و " & D & " هل تريد الاستمرار؟", vbYesNo, "تنبيه") = vbNo Then 'لتفريغ الحقول فقط A = Null B = Null C = Null D = Null End If End If للأسف لم استطع استخدام الكود في مثالك ......... نظرا لاستخدامك اللغة العربية في التسميات ............

لان الكود ينظر لاول تريقيم في الجدول وليس الترقيم الذي انت تريده ( بداية الترقيم قي السنه ) انظر هذا الكود وتفحصة لتعرف ما الذي يجب عليك تعديلة ليفهم الكود بداية الترقيم Em.21001 DoCmd.GoToRecord , "", acNewRec Rc.MoveFirst ChequesFound = Rc.GetRows(Rc.RecordCount) ChequeNoStart = ChequesFound(0, 0) ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2)) اما الكود الذي وجدته فلا يعيد الارقام المفقودة !!!!!

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

lمشاركة مع البش مهندس ... max&^min.accdb

ارفق مثال مصغر للمطلوب ؛؛؛؛؛؛؛؛

المنتدى للتعلم بارك الله فيك ..... حاول في الكود .... غير ... بدل ... ضيف .... احذف .... حتى تصل ... ما تخسر شيئ بل تكتسب خبرة

ههههه .... اذن حاول انقاذ الموقف .... بتعديل كودك .... 😁

لكن لو فكرت منطقيا ... انت اعتمدت على السنه في الترقيم .. صحيح اذن ... سوف تواجه مشكلة العام القادم ... ليش منطقيا ان كل عام له ترقيمه الخاص ... يعني كل سنه يبدأ ترقيم من جديد .... السؤال ... لك .... للتعلم .... كيف يمكن تعديل الكود السابق حتى نتلافى تلك المشكلة ؟؟؟ اريد انت تفكر بطرق حل تلك المشكلة برمجيا !!

استبدل الكود الموجود لديك بهذا الكود ..... On Error Resume Next Dim Db As DAO.Database Dim Rc As DAO.Recordset Dim ChequesFound Dim ChequeNoStart As Long Dim ChequeNoEnd As Long Dim i As Long Set Db = CurrentDb Set Rc = Db.OpenRecordset("SELECT SamoBrojevitxt([dbo_ID]) AS Brojevtxti FROM dbo_Tbl_Emp ORDER BY SamoBrojevitxt([dbo_ID]);") Do While Not Rc.EOF Rc.MoveNext Loop If Rc.RecordCount = 0 Then dbo_ID = "Em." & Right(Year(Date), 2) & "001" 'MsgBox "No Records Found" GoTo cmdDisplay_Exit End If DoCmd.GoToRecord , "", acNewRec Rc.MoveFirst ChequesFound = Rc.GetRows(Rc.RecordCount) ChequeNoStart = ChequesFound(0, 0) ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2)) For i = ChequeNoStart To ChequeNoEnd If BinarySearch(ChequesFound, i) = False Then dbo_ID = "Em." & i GoTo cmdDisplay_Exit Else dbo_ID = "Em." & Replace(Nz(DMax("dbo_ID", "dbo_Tbl_Emp", "dbo_ID like 'Em." & Right(Year(Date), 2) & "*'"), "Em." & Right(Year(Date), 2) & "000"), "Em.", "") + 1 End If Next i cmdDisplay_Exit: Set Rc = Nothing Set Db = Nothing

بعد الانتهاء من اضافة الموظف قم بالضغط على حفظ ....... انظر المرفق ربما هو ما تريد .... dbo_da_kan.accdb

ممكن مرفق صغير للتعديل عليه .... لان الشغلة تحتاج عمل واكواد بارك الله فيك

تفضل استخدمن استعلام الحاق ::::::: DoCmd.SetWarnings False DoCmd.RunSQL "INSERT INTO tbl3 ( stname1, class1, stid ) SELECT tbl1.stname, tbl1.class, [forms]![frmmain]![id] AS K FROM tbl1 WHERE (((tbl1.class)=[forms]![frmmain]![lst4]));" DoCmd.SetWarnings True movemanyrecords (1).accdb

تفضل الملف 2003 TEST_OD _2003.mdb

نعم صحيح ...

زيادة في اثراء الموضوع .....

انظر الاستعلام وطبق ماتريد بها ..... TEST_OD.accdb

أخي الكريم @عمر ضاحى انت من تستحق افضل اجابة ... وهذا رأي بارك الله فيك .... واشكر حسن ظنك في ..

كلام اخي الكريم عمر صحيح .... حتى تسهل على المجيب ... عشان لايضطر المجيب لتصميم قاعدة لكل سائل .... حرصا على وقته .... بارك الله فيك اخي عمر ... انظر المرفق ... kan_a.accdb

أخي الفاضل بارك الله فيك احي فيك هذه الرغبة في التعلم .... نصيحة لك اقرأ كثريا عن الدوال .... Asc ,Mid هذه دوال Asc تقوم بارجاع كل حرف او رقم في لوحة المفاتتيح الى القيمة الرقمية لها ليتم التعرف عليها هل هي حرف ام رقم ليتم عن طريق Mid اقتصاصها لو كلنت رقما طبعا لو تابعت الكود فيه حلقة تكرار For ليتم المرور على كل حرف او رقم موجود في السلسلة النصية الموجودة في الكمبوبكس .... لمزيد من الدوال في المرفق .... Microsoft Access Functions.pdf

هل تقصد هكذا ؟؟؟؟؟

تفضل >>>>>>> Function Seperate_Digits(T) ' هذا الفانك لاقتصاص الارقام من النص If Len(T & "") = 0 Then Seperate_Digits = "" Exit Function End If For i = 1 To Len(T) C = Asc(Mid(T, i, 1)) Select Case C Case 46, 48 To 57 Which_Letter = Which_Letter & Mid(T, i, 1) Case 47 Which_Letter = "" End Select Next i Seperate_Digits = Which_Letter End Function Private Sub cbList1_AfterUpdate() ' متغيرات Dim a, aa, ff As Integer Dim st As String 'اقتصاص رقم الشهر من الكمبو بكس الموجود في النموذج a = Seperate_Digits(Me.cbList1) 'عدد ايام الشهر المختار aa = CVDate(a) * 30 st = Day(DateSerial(Year(aa), Month(aa) + 1, 0)) 'ادخال تلك المتغيرات في العملية الحسابية ff = (Me.نص692 * Me.txtTotalSalary) / st Me.txtdaysalary1 = ff End Sub

انظر الصورة وطبق ..... pro.accdb