amir_adam83 قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 السلام عليكم ورحمة الله وبركاتة لدي كود الترقيم التلقائي وهو TextID = "AD." & Replace(Nz(DMax("TextID", "Table", "TextID like 'AD." & Right(Year(Date), 2) & "*'"), "AD." & Right(Year(Date), 2) & "000"), "AD.", "") + 1 وهو يعمل بصوره ممتازه ولكن عند البداء AD.210001 AD.210002 AD.210003 AD.210004 AD.210005 AD.210006 AD.210007 AD.210008 وهو يعمل بصوره اكثر من رائعه ولكن عند حذف رقم AD.210003 واخر رقم متوقف عنده العد التلقائي هو AD.210008 عند اضافة جديده ياتي برقم AD.210009 واعتبر رقم AD.210003 متواجد اريده يتم البحث عن الارقام المفقوده وياتي به وبعد هذا الرقم يبداء العد تلقائي هل من طريقه بارك الله فيكم رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 ممكن مرفق صغير للتعديل عليه .... لان الشغلة تحتاج عمل واكواد بارك الله فيك 5 رابط هذا التعليق شارك More sharing options...
أمير ادم قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 اشكرك اخي الكريم تفضل dbo_da.rar رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 2, 2021 مشاركة قام بنشر سبتمبر 2, 2021 بعد الانتهاء من اضافة الموظف قم بالضغط على حفظ ....... انظر المرفق ربما هو ما تريد .... dbo_da_kan.accdb 4 1 رابط هذا التعليق شارك More sharing options...
أمير ادم قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 بارك الله فيك وجزاك الله خير الجزاء هذا بالفعل هو المطلوب ولكن قابلتني مشكله عند تفريغ الجدول للعمل عليه من جديد مثل الصورة رقم واحد وعند اضافة رقم صفر في البداية ياتي بالترقيم الصحيح وعند اضافة رقم 2 ياتي بترقيم غير الترقيم رقم 1 رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 استبدل الكود الموجود لديك بهذا الكود ..... 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 6 رابط هذا التعليق شارك More sharing options...
أمير ادم قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 احسنت اخي الكريم بارك الله فيك وجزاك الله خير الجزاء بالفعل هذا هو المطلوب شكرا لك 1 رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 لكن لو فكرت منطقيا ... انت اعتمدت على السنه في الترقيم .. صحيح اذن ... سوف تواجه مشكلة العام القادم ... ليش منطقيا ان كل عام له ترقيمه الخاص ... يعني كل سنه يبدأ ترقيم من جديد .... السؤال ... لك .... للتعلم .... كيف يمكن تعديل الكود السابق حتى نتلافى تلك المشكلة ؟؟؟ اريد انت تفكر بطرق حل تلك المشكلة برمجيا !! 6 رابط هذا التعليق شارك More sharing options...
أمير ادم قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 بالفعل قولك صحيح😃 استاذي الكريم لكن انت استاذنا ونحن من هم يتعلمون منكم برك الله فيكم وجعلكم عونا لنا تم تعديل تاريخ الكمبيوتر للعام المقبل 2022 بالفعل اتي لي EM.220010 ولم يعد من نقظة الصفر للعام الجديد 1 رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 ههههه .... اذن حاول انقاذ الموقف .... بتعديل كودك .... 😁 6 رابط هذا التعليق شارك More sharing options...
أمير ادم قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 كيف وانا لا اعلم😄 1 رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 3, 2021 مشاركة قام بنشر سبتمبر 3, 2021 المنتدى للتعلم بارك الله فيك ..... حاول في الكود .... غير ... بدل ... ضيف .... احذف .... حتى تصل ... ما تخسر شيئ بل تكتسب خبرة 4 رابط هذا التعليق شارك More sharing options...
amir_adam83 قام بنشر سبتمبر 4, 2021 الكاتب مشاركة قام بنشر سبتمبر 4, 2021 وجدت هذا الكود Private Sub Form_BeforeInsert(Cancel As Integer) On Error Resume Next Dim xLast, xNext As Integer Dim prtyr, prtTxt As Integer prtyr = Right(DatePart("yyyy", Date), 2) prtTxt = Left(DMax("dbo_ID", "dbo_Tbl_Emp"), 2) xLast = DMax("dbo_ID", "dbo_Tbl_Emp", prtTxt = prtyr) If IsNull(xLast) Then xNext = 1 Else xNext = Val(Mid(xLast, 3, 5)) + 1 End If Me!dbo_ID = prtyr & Format(xNext, "00000") End Sub في وهو يعمل بصوره صحيحه ولكن استاذي الكريم لماذا اذا حذفت رقم 1 ورقم2ورقم3و ياتي بالترقيم رقم اربعه ولم ياتي برقم 1-2-3 ولكن عند حذف اي رقم بعد الترقيم رقم واحد ياتي به صحيح ولا يوجد مشكله dbo_da_ka11n.rar رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 4, 2021 مشاركة قام بنشر سبتمبر 4, 2021 لان الكود ينظر لاول تريقيم في الجدول وليس الترقيم الذي انت تريده ( بداية الترقيم قي السنه ) انظر هذا الكود وتفحصة لتعرف ما الذي يجب عليك تعديلة ليفهم الكود بداية الترقيم Em.21001 DoCmd.GoToRecord , "", acNewRec Rc.MoveFirst ChequesFound = Rc.GetRows(Rc.RecordCount) ChequeNoStart = ChequesFound(0, 0) ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2)) اما الكود الذي وجدته فلا يعيد الارقام المفقودة !!!!! 3 رابط هذا التعليق شارك More sharing options...
amir_adam83 قام بنشر سبتمبر 5, 2021 الكاتب مشاركة قام بنشر سبتمبر 5, 2021 السلام عليكم استاذي الكريم @kanory تم وضع وتعديل الكود DoCmd.GoToRecord , "", acNewRec Rc.MoveFirst ChequesFound = Rc.GetRows(Rc.RecordCount) ChequeNoStart = ChequesFound(0, 0) ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2)) ولكن المشكله تكمن كما هي ولا يوجد جديد اولا: عند التحويل لعام جديد ياتي باول كود فقطEm.21001 وعند اضافة موظف جديد في نفس العام ياتيEm.20008 رغم اني اعمل بعام 2021 ثانيا لا يستطيع الفصل بين العام الماضي والحالي بعتذر على الاطالة في مساعدتي بارك الله فيكم رابط هذا التعليق شارك More sharing options...
أفضل إجابة kanory قام بنشر سبتمبر 5, 2021 أفضل إجابة مشاركة قام بنشر سبتمبر 5, 2021 طيب ... جرب المرفق ووافينا بالنتيجة ... dbo_da_kan.accdb 3 1 رابط هذا التعليق شارك More sharing options...
amir_adam83 قام بنشر سبتمبر 5, 2021 الكاتب مشاركة قام بنشر سبتمبر 5, 2021 2 hours ago, kanory said: طيب ... جرب المرفق ووافينا بالنتيجة ... dbo_da_kan.accdb 552 kB · 1 download مشاء الله تبارك الله الله يعطيك الف عافية هذا بالفعل هو المطلوب تم اختبار حذف ارقام بعد رقم 1 وتم اعادة الترقيم للاقام التى تم حذفها وتم اختباره على عام جديد يعمل بصوره مائه بالمائه وهذا مايطلبه الكثير لعله في ميزان حسناتك ان شاء الله جزاك الله الف خير شكرا جزيل رابط هذا التعليق شارك More sharing options...
kanory قام بنشر سبتمبر 5, 2021 مشاركة قام بنشر سبتمبر 5, 2021 بارك الله فيك اخي امير وعلى سعة صدرك ... 3 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان