kanory

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

استبدل الكود الموجود لديك بهذا الكود ..... 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

انظر المرفق ..... ربما هو طلبك ... pro.accdb

ممكن مثال لمطلوبك للتوضيح ...

الحمد لله رب العالمين

me.kan=" "

طيب بلاش الكود .... جرب المرفق عسى يكون المطلوب ... kan_a.accdb

استخدم هذا الكود .... Call SetWindowPos(handleW1, 0, 0, 0, 0, 0, TOGGLE_UNHIDEWINDOW)

الحمد لله رب العالمين ....... بالتوفيق ,,,,

وعليكم السلام اوقف عمل هذا الجزء 'Me.Undo

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

حياك الله شيخ الزهارين ..... بالتوفيق ... ليش حذف افضل اجابة ؟؟؟؟؟ ههههههه