اذهب الي المحتوي
أوفيسنا

ترقيم تلقائي يتجدد كل سنة


ابوخليل

الردود الموصى بها

ترقيم تلقائي يتجدد مع بداية كل سنة على النحو التالي

1300001

1300002

1300003

1400001

1400002

وهكذا .................  باعتبار الرقم  13 ، 14 هو السنة 

والترقيم لاشك سيكون تبعا للسنة الحالية

 

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("ID", "tbl1"), 2)
xLast = DMax("ID", "tbl1", prtTxt = prtyr)
If IsNull(xLast) Then
xNext = 1
Else
xNext = Val(Mid(xLast, 3, 5)) + 1
End If
Me!ID = prtyr & Format(xNext, "00000")
End Sub

 

ترقيم تلقائي جديد كل سنة.rar

  • Like 17
  • Thanks 2
رابط هذا التعليق
شارك

السلام عليكم ورحمة الله وبركاته

استاذنا ابوخليل

ما شاء الله تبارك الله

عمل ممتاز وله فوائده العدة التي يمكن ان استخدمه فيها

 

شكرا وبارك الله فيك

:wow:

رابط هذا التعليق
شارك

صراحة ... مجهود أكثر من رائع

نشكركم أخى الكريم

ولكن ....

فى حالة المشروع الخاص بى الأمر صعب جداً لأن أنا عندى قاعدة بيانات من 2009 ويصعب الإعتماد على الترقيم التلقائى

لأننى أعتمد على الإدخال اليدوى

فممكن أدخل سيرال 1 مثلا و أقم بإدخال 5 بعد ذلك

 

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

وهو أمر شديد التعقيد خصوصا اذا كانت البيانات المنزلة يوميا 50 بيان

 

وشكراً أخى

رابط هذا التعليق
شارك

  • 1 year later...
  • 6 months later...

السلام عليكم ورحمة الله وبركاته
استاذنا ابوخليل

كل الشكر والتقدير على هذه المعلومة الطيبة

شكرا وبارك الله فيك

رابط هذا التعليق
شارك

 
في 24‏/7‏/2014 at 15:52, ابوخليل said:

 


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("ID", "tbl1"), 2)
xLast = DMax("ID", "tbl1", prtTxt = prtyr)
If IsNull(xLast) Then
xNext = 1
Else
xNext = Val(Mid(xLast, 3, 5)) + 1
End If
Me!ID = prtyr & Format(xNext, "00000")
End Sub

 

 

 

هل يمكن ظهور ID على النحول التالي 2016/001

Me!ID = prtyr & "/" & Format(xNext, "000")

 

رابط هذا التعليق
شارك

يمكن وعلى نحو ما تفضلت به ولكننا نحتاج الى بعض التعديلات  

   التعديل الاول على نوع الحقل id  داخل الجدول الى نص بدلا من رقم حتى يقبل الرموز

  التعديل الثاني : هو اجراء المقارنة على الارقام الثلاثة الاخيرة بدلا من مقارنة الرقم كاملا والسبب وجود الرمز الفاصل

وتعديلات اخرى يمكنك ملاحظتها  عند المقارنة مع الكود السابق

Private Sub Form_BeforeInsert(Cancel As Integer)
On Error Resume Next
Dim xLast, xNext As Integer
Dim prtyr, prtTxt As Integer
prtyr = DatePart("yyyy", Date)
prtTxt = CLng(Left(DMax("ID", "tbl1"), 4))
xLast = CLng(Right(DMax("ID", "tbl1", prtTxt = prtyr), 3))
If IsNull(xLast) Then
xNext = 1
Else
xNext = xLast + 1
End If
Me!ID = prtyr & "/" & Format(xNext, "000")
End Sub

 

 

ترقيم مع السنة.rar

  • Like 2
رابط هذا التعليق
شارك

  • 3 months later...

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

 

ترقيم تلقائي جديد كل.rar

رابط هذا التعليق
شارك

الاخ الغالي : ابو خليل 

كل عام وانت طيب اولا

ما زلت اقول بانك ثروة ويجب الحفاظ عليها

ما هدا الجمال ؟ ؟     زادك الله علما ونفعك به 

  • Like 1
رابط هذا التعليق
شارك

  • 2 months later...
في ١٢‏/٦‏/٢٠١٦ at 23:23, حلبي said:

الاخ الغالي : ابو خليل 

كل عام وانت طيب اولا

ما زلت اقول بانك ثروة ويجب الحفاظ عليها

ما هدا الجمال ؟ ؟     زادك الله علما ونفعك به 

جزاك الله خيرا  وزادك جمالا في قلبك وبدنك

في ٢٤‏/٧‏/٢٠١٤ at 16:52, ابوخليل said:

 


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("ID", "tbl1"), 2)
xLast = DMax("ID", "tbl1", prtTxt = prtyr)
If IsNull(xLast) Then
xNext = 1
Else
xNext = Val(Mid(xLast, 3, 5)) + 1
End If
Me!ID = prtyr & Format(xNext, "00000")
End Sub

 

 هلا اخي محمد .. الحل قريب منك جدا  ... واقول جزاك الله خيرا  على اثراء الموضوع

آخر سطر في الكود اعلاه سيصبح :

Me!ID = "S" & prtyr & Format(xNext, "00000")

ولا تنسى ان تبدل نوع الحقل  ID  الى نصي 

  • Like 1
رابط هذا التعليق
شارك

3 ساعات مضت, محمد سلامة said:

هل يمكن اضافة بادئة نصية مثل حرف مثلا ؛

S160001

S160002

وهكذ... 

لو ترفع موضوعا جديدا افضل 

وهل ممكن يصل الترقيم لديك الى 1699999 ؟!!

تم تعديل بواسطه رمهان
  • Like 1
رابط هذا التعليق
شارك

3 ساعات مضت, ابوخليل said:

جزاك الله خيرا  وزادك جمالا في قلبك وبدنك

 هلا اخي محمد .. الحل قريب منك جدا  ... واقول جزاك الله خيرا  على اثراء الموضوع

آخر سطر في الكود اعلاه سيصبح :


Me!ID = "S" & prtyr & Format(xNext, "00000")

ولا تنسى ان تبدل نوع الحقل  ID  الى نصي 

بارك الله فيك استاذ ابوخليل فعلا لم يخطر علي بالي ان الحل قريب هكذا.. بارك الله فيك

منذ ساعه, رمهان said:

لو ترفع موضوعا جديدا افضل 

وهل ممكن يصل الترقيم لديك الى 1699999 ؟!!

اهلا بك استاذ رمهان.. كنت سافتح موضوع جديد ولكن فضلت ان اكتب هنا مع الموضوع

لا اعتقد ان اصل الي هذا الرقم في خلال السنة الواحدة 

شكرا استاذ رمهان

رابط هذا التعليق
شارك

5 ساعات مضت, رمهان said:

لو ترفع موضوعا جديدا افضل 

طلب الاستاذ محمد سلامة في صميم الموضوع

وقد علقت على سؤاله  :

7 ساعات مضت, ابوخليل said:

  ... واقول جزاك الله خيرا  على اثراء الموضوع

ولا بأس استاذ رمهان ان ترفع انت موضوعا جديدا تتحفنا فيه  بما في جعبتك مع الشكر والتقدير

  • Like 1
رابط هذا التعليق
شارك

14 ساعات مضت, ابوخليل said:

طلب الاستاذ محمد سلامة في صميم الموضوع

وقد علقت على سؤاله  :

ولا بأس استاذ رمهان ان ترفع انت موضوعا جديدا تتحفنا فيه  بما في جعبتك مع الشكر والتقدير

استاذنا العزيز ابوخليل

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

S160001

S160001

S160001

لا يتم زيادة الرقم مع كلسجل 

تحياتي

رابط هذا التعليق
شارك

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

اي فرضا لو وصل الترقيم 1399999   اي هناك اكثر من تسعة وتسعون الف وتسعمائة وتسع وتسعون سجل في السنة سنة 2013 فماهي السياسة في الزيادة . فلو استمرينا باضافة 1 سيكون السجل التالي يبدا 14 ونحن مازلنا في نفس السنة . ولكن حسب رأي الاخ محمد سلامة بانه لن يحصل خلال السنة فهذا الكود سيعمل وبدون اللاحقة s . لكي يضل المحتوى نفس الموضوع.

Private Sub Form_BeforeInsert(Cancel As Integer)
If Right(Year(Date), 2) > Left(DMax("ID", "tbl1"), 2) Then
xNext = Right(Year(Date), 2) & "00001"
Else
xNext = DMax("ID", "tbl1") + 1
End If
ID = xNext
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

8 ساعات مضت, محمد سلامة said:

استاذنا العزيز ابوخليل

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

S160001

S160001

S160001

لا يتم زيادة الرقم مع كلسجل 

تحياتي

 معذرة اخي محمد لم انتبه ان المسألة بحاجة الى تعديل آخر

لاحظ السطر   هذا  الموجود في الكود

xNext = Val(Mid(xLast, 3, 5)) + 1

فيه حاجة لازم تتغير في السطر اعلاه ، لأننا اضفنا حرفا الى الترقيم  الذي هو حرف s

فالرقم  3  يعني اننا سنبدأ العد من اليسار ابتداء من الحرف الثالث الى السابع  ، ثم نضيف اليه واحد

ولكن الحرف الثالث من اليسار في الكود الأصلي  هو الرقم الذي يأتي بعد السنة ( التي هي رقمين )

ولكننا اضفنا حرف s قبل رقمي السنة  لذا يجب ان نعدل  الـرقم 3 الى 4 لكي نبدأ من الحرف ( او الرقم ) الرابع

لذا يجب ان نعدل السطر المذكور ليصبح

xNext = Val(Mid(xLast, 4, 5)) + 1

اعلم انه يكفيك الاشارة  الى مكان الخلل

ولكني تبسطت بالشرح لمن يأتي  لاحقا

 

 

 

  • Like 2
رابط هذا التعليق
شارك

21 ساعات مضت, ابوخليل said:

 معذرة اخي محمد لم انتبه ان المسألة بحاجة الى تعديل آخر

لاحظ السطر   هذا  الموجود في الكود


xNext = Val(Mid(xLast, 3, 5)) + 1

فيه حاجة لازم تتغير في السطر اعلاه ، لأننا اضفنا حرفا الى الترقيم  الذي هو حرف s

فالرقم  3  يعني اننا سنبدأ العد من اليسار ابتداء من الحرف الثالث الى السابع  ، ثم نضيف اليه واحد

ولكن الحرف الثالث من اليسار في الكود الأصلي  هو الرقم الذي يأتي بعد السنة ( التي هي رقمين )

ولكننا اضفنا حرف s قبل رقمي السنة  لذا يجب ان نعدل  الـرقم 3 الى 4 لكي نبدأ من الحرف ( او الرقم ) الرابع

لذا يجب ان نعدل السطر المذكور ليصبح


xNext = Val(Mid(xLast, 4, 5)) + 1

اعلم انه يكفيك الاشارة  الى مكان الخلل

ولكني تبسطت بالشرح لمن يأتي  لاحقا

 

 

 

شكرا استاذنا الحبيب ابو خليل 

ولكن للاسف ايضا لم تظبط معي ويظل الترقيم كما هو ثابت لا يضيف رقم على كل سجل جديد 

لقد قمت بتعديل الرقم 3 الى 4 وايضا يظل الرقم ثابت  ... وقمت بعدة محاولات ولم تفلح معي للاسف الشديد
الترقيم جيد جدا بدون اضافة البادئة النصية ..  وبعد اضافتها يظل الترقيم كما هو 

مع العلم ان البادئة النصية فائدتها هى لتمييز المكاتبات الواردة بحرف ال (W)  من المكاتبات الصادر بحرف ال  (S)  

 فعفوا هل يمكن ان تجربها بنفسك

تم تعديل بواسطه محمد سلامة
رابط هذا التعليق
شارك

23 ساعات مضت, رمهان said:

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

اي فرضا لو وصل الترقيم 1399999   اي هناك اكثر من تسعة وتسعون الف وتسعمائة وتسع وتسعون سجل في السنة سنة 2013 فماهي السياسة في الزيادة . فلو استمرينا باضافة 1 سيكون السجل التالي يبدا 14 ونحن مازلنا في نفس السنة . ولكن حسب رأي الاخ محمد سلامة بانه لن يحصل خلال السنة فهذا الكود سيعمل وبدون اللاحقة s . لكي يضل المحتوى نفس الموضوع.


Private Sub Form_BeforeInsert(Cancel As Integer)
If Right(Year(Date), 2) > Left(DMax("ID", "tbl1"), 2) Then
xNext = Right(Year(Date), 2) & "00001"
Else
xNext = DMax("ID", "tbl1") + 1
End If
ID = xNext
End Sub

 

شكرا استاذ رمهان .. ولكن الكود لا يعمل ولا يضيف اي رقم بتاتاً 

ثانيا : الكود لا يحتوى على البادئة النصية 

رابط هذا التعليق
شارك

صحيح  كان الاولى  التجربة حتى نختصر الوقت والجهد

تفضل اخي الحبيب

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 = CLng(Mid(DMax("ID", "tbl1"), 2, 2))
xLast = CLng(Right(DMax("ID", "tbl1", prtTxt = prtyr), 5))
If IsNull(xLast) Then
xNext = 1
Else
xNext = xLast + 1
End If
Me!ID = "S" & prtyr & Format(xNext, "00000")
End Sub

 

ترقيم مع السنة وزيادة حرف.rar

  • Like 3
رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information