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

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

قام بنشر

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

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 3
قام بنشر

بارك الله فيك وجزاك الله خير اخونا الغالي ابو خليل 

 

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

 

مثال رائع ومفيد  ونحن بحاجه له

 

وفقك الله ورعاك اخي

قام بنشر

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

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

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

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

 

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

:wow:

قام بنشر

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

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

ولكن ....

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

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

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

 

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

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

 

وشكراً أخى

  • 1 year later...
  • 6 months later...
قام بنشر

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

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

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

قام بنشر
 
  في 24‏/7‏/2014 at 13: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

 

 

 

Expand  

هل يمكن ظهور 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...
قام بنشر
  في 12‏/6‏/2016 at 20:23, حلبي said:

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

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

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

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

Expand  

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

  في 24‏/7‏/2014 at 13: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

 

Expand  

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

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

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

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

  • Like 1
قام بنشر (معدل)
  في 15‏/8‏/2016 at 18:27, محمد سلامة said:

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

S160001

S160002

وهكذ... 

Expand  

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

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

تم تعديل بواسطه رمهان
  • Like 1
قام بنشر
  في 15‏/8‏/2016 at 19:39, ابوخليل said:

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

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

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

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

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

Expand  

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

  في 15‏/8‏/2016 at 21:34, رمهان said:

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

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

Expand  

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

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

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

قام بنشر
  في 15‏/8‏/2016 at 21:34, رمهان said:

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

Expand  

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

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

  في 15‏/8‏/2016 at 19:39, ابوخليل said:

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

Expand  

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

  • Like 1
قام بنشر
  في 16‏/8‏/2016 at 02:57, ابوخليل said:

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

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

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

Expand  

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

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

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
قام بنشر
  في 16‏/8‏/2016 at 17:11, محمد سلامة said:

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

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

S160001

S160001

S160001

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

تحياتي

Expand  

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

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

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

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

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

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

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

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

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

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

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

 

 

 

  • Like 2
قام بنشر (معدل)
  في 16‏/8‏/2016 at 22:54, ابوخليل said:

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

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

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

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

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

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

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

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

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

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

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

 

 

 

Expand  

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

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

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

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

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

تم تعديل بواسطه محمد سلامة
قام بنشر
  في 16‏/8‏/2016 at 20:53, رمهان 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

 

Expand  

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

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

قام بنشر

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

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

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