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

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


ابوخليل

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

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

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

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

جرب ان تضيف قيمة واحدة على الاقل في حقل id  ولتكن 1600001 

ادخل قيم

غير تاريخ الجهاز لسنة 2017 وهكذا

طبعا بدون اضافة اللاحقة النصية

تحياتي

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

6 ساعات مضت, ابوخليل 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 = 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

لي تعقيب بسيط للتنبيه والفائدة هنا

هذا الشرط ليس لوجوده اهمية فهو يعمل مقارنة بين متغيرين تم اخذ قيمة لهما فوجوده زائد

xLast = CLng(Right(DMax("ID", "tbl1", prtTxt = prtyr), 5))

اي يمكن ان يصبح السطر هكذا

xLast = CLng(Right(DMax("ID", "tbl1"), 5))

كما ان استخدام الدالة clng  لاحقا للتحويل تحتاج لوقفة ولكن بعد تفضل الاستاذ ابو خليل بشرح السبب ؟ فقد يبطل العجب !

وهنا استسمح صاحب الموضوع باختصار الكود بدون اي فكرة اضافية او عملية اختزال

Private Sub Form_BeforeInsert(Cancel As Integer)
prtyr = Right(DatePart("yyyy", Date), 2)
xLast = Right(DMax("ID", "tbl1"), 5)
If IsNull(xLast) Then
xNext = 1
Else
xNext = xLast + 1
End If
Me!ID = "S" & prtyr & Format(xNext, "00000")
End Sub

تحياتي

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

وجدت لكم بالجعبة الفقيرة السطر التالي ولطلب الاخ محمد سلامة

Private Sub Form_BeforeInsert(Cancel As Integer)
ID = "S" & Replace(Nz(DMax("id", "tbl1", "id like 's" & Right(Year(Date), 2) & "*'"), "s" & Right(Year(Date), 2) & "00000"), "s", "") + 1
End Sub

كما يمكن وضع السطر السابق كقيمة افتراضية للعنصر وبدون كود 

بالتوفيق

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

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

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

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

استاذ ابو خليل وفقك الله 

انا حاولت اعمل ذلك ولكن ليس على السنة بل على اليوم بحيث كل يوم جديد يبداء الرقم من 1 حاولت التعديل على ما تفضلت به ولكن ظهر لدي خطاء وعجزت عن الحل 

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

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

غير في هذا السطر فقط :


prtyr = Right(DatePart("yyyy", Date), 2)

ليصبح بعد التعديل هكذا :


prtyr = DatePart("d", Date)

 

بارك الله فيك وفي بقية الأخوة ولكن لو تسمح نتزيد منكم  كيف لو اردت ان يتجدد التاريخ بناء على حقل للتاريخ وليس على تاريخ الجهاز على اعتبار ان اسم الحقل s_date

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

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

لو شرحت  الفكرة التي تريد تطبيقها   ، فقد نجد حلول أخرى مختلفة

شكر الله لك استاذ ابو خليل على كريم تواصلك دايم نستفيد منك 

المثال المرفق موضح بداخله المطلوب حاولت جاهداً ان اتوصل لحل بناء على المثال الذي تكرمت انت به ولم اوفق ذلك 

هناك اربع حقول 

حقل الرقم يعتمد على حقل التاريخ بحيث لو تم اضافة تاريخ جديد يبداء الرقم من 1 واذا نفس التاريخ يكمل الى 2 وهكذا

وفي اليوم التالي او عند ادخال رقم جديد في حقل التاريخ يبداء العد من جديد ب 1

في حقل الكود هذه اضافة اتمنى التكرم بالمساعدة فيها 

بحيث يكون حقل الكود عبارة عن السنة الحالية والشهر واليوم ثم - الرقم

db9790.rar

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

6 ساعات مضت, سمير1404 said:

شكر الله لك استاذ ابو خليل على كريم تواصلك دايم نستفيد منك 

المثال المرفق موضح بداخله المطلوب حاولت جاهداً ان اتوصل لحل بناء على المثال الذي تكرمت انت به ولم اوفق ذلك 

هناك اربع حقول 

حقل الرقم يعتمد على حقل التاريخ بحيث لو تم اضافة تاريخ جديد يبداء الرقم من 1 واذا نفس التاريخ يكمل الى 2 وهكذا

وفي اليوم التالي او عند ادخال رقم جديد في حقل التاريخ يبداء العد من جديد ب 1

في حقل الكود هذه اضافة اتمنى التكرم بالمساعدة فيها 

بحيث يكون حقل الكود عبارة عن السنة الحالية والشهر واليوم ثم - الرقم

db9790.rar

استأذن من استاذنا ابو خليل على المداخلة
اتفضل ما طلبت
للعلم انا غيرت اسماء الحقول من number الى number1
ومن code الى code1
لان تلك الاسماء محجوزة لكي يتجنب من الاخطاء

واتفضل استخدمت هذا الكود

Private Sub f_date_AfterUpdate()
On Error Resume Next
If Me.number1 <> 0 Then
Me.Undo
Exit Sub
End If
If DCount("number1", "tp1") < 1 Or IsNull(DMax("number1", "tp1", "[f_date]=#" & Format(Me.f_date.Value, "dd/mm/yyyy") & "#")) = True Then
        Me.number1 = 1
    Me.code1 = Left(Right(Me.f_date, 2), 4) & "\" & Format(Me.f_date, "mm") & "\" & Format(Me.f_date, "dd") & "-000" & Me.number1
        Else
    Me.number1 = DMax("number1", "tp1", "[f_date] =#" & Format(Me.f_date.Value, "dd/mm/yyyy") & "#") + 1
Me.code1 = Left(Right(Me.f_date, 2), 4) & "\" & Format(Me.f_date, "mm") & "\" & Format(Me.f_date, "dd") & "-000" & Me.number1
End If
End Sub

واليك ملفك بعد تعديل

واذا ما فهمت من الكود راح نشرح لك باذن الله

تقبل تحياتي

db9790.rar

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

في ٢٩‏/٣‏/٢٠١٧ at 18:36, Shivan Rekany said:

استأذن من استاذنا ابو خليل على المداخلة
اتفضل ما طلبت
للعلم انا غيرت اسماء الحقول من number الى number1
ومن code الى code1
لان تلك الاسماء محجوزة لكي يتجنب من الاخطاء

واتفضل استخدمت هذا الكود


Private Sub f_date_AfterUpdate()
On Error Resume Next
If Me.number1 <> 0 Then
Me.Undo
Exit Sub
End If
If DCount("number1", "tp1") < 1 Or IsNull(DMax("number1", "tp1", "[f_date]=#" & Format(Me.f_date.Value, "dd/mm/yyyy") & "#")) = True Then
        Me.number1 = 1
    Me.code1 = Left(Right(Me.f_date, 2), 4) & "\" & Format(Me.f_date, "mm") & "\" & Format(Me.f_date, "dd") & "-000" & Me.number1
        Else
    Me.number1 = DMax("number1", "tp1", "[f_date] =#" & Format(Me.f_date.Value, "dd/mm/yyyy") & "#") + 1
Me.code1 = Left(Right(Me.f_date, 2), 4) & "\" & Format(Me.f_date, "mm") & "\" & Format(Me.f_date, "dd") & "-000" & Me.number1
End If
End Sub

واليك ملفك بعد تعديل

واذا ما فهمت من الكود راح نشرح لك باذن الله

تقبل تحياتي

db9790.rar

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

هل ممكن ان يكون ذلك حتى على التاريخ الهجري ايضا

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

عجزت فعلا عن الوصول لحل مثل ذلك والبركة فيكم تجودون علينا من علمكم الكريم 

تم تعديل بواسطه سمير1404
خطاء في توضيح المطلوب
رابط هذا التعليق
شارك

  • 3 months later...

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

الكود بهذا الشكل يخرج لي نتيجة s17/00001   وهكذا صعودا  ...

هل يمكن اظهاره بالشكل  s2017/00001   وهكذا صعودا ؟؟؟ علما اني غيرت في السطر الرابع prtyr  الرقم 2 الى 4  وظهر لي ما اردت لكنه يبقى ثابتا بتسلسل 1 لجميع السجلات .

مع التحية والتقدير .

 
On Error Resume Next
Dim xLast, xNext As Integer
Dim prtyr, prtTxt As Integer
prtyr = Right(DatePart("yyyy", Date), 2)
prtTxt = CLng(Mid(DMax("seq", "tb1"), 2, 2))
xLast = CLng(Right(DMax("seq", "tb1", prtTxt = prtyr), 5))
If IsNull(xLast) Then
xNext = 1
Else
xNext = xLast + 1
End If
Me!Seq = "S" & prtyr & "/" & Format(xNext, "00000")
تم تعديل بواسطه عذاب الزمان
رابط هذا التعليق
شارك

37 دقائق مضت, عذاب الزمان said:

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

الاستاذ رمهان المحترم

الكود الذي قمت انت بتعديله كان رائعا وهو فعلا ما اريده فقد غيرت 2 الى 4 واشتغل وشكرا جزيلا 

 

 

Dim xLast, xNext, prtyr As Integer
prtyr = Right(DatePart("yyyy", Date), 4)
xLast = Right(DMax("id", "tbl1"), 3)
If IsNull(xLast) Then
xNext = 1
Else
xNext = xLast + 1
End If
Me!id = "S" & "/" & prtyr & "/" & Format(xNext, "000")
 
لي سؤال واحد فقط بخصوص هذا الموضوع : اريد ان يكون التسلسل  s/001  وهكذا   s/002  اي من دون اظهار السنة كما هو الان  s/2017/001  
ولكم جميعا التحية والتقدير .
وانا واكتب خطر لي ان احذف  prtyr & "/" 
وجربت ذلك ونحجت ....
موقع رائع واساتذة كبار ولكم مني خالص التحية والاحترام .

 

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

في ٢١‏/٧‏/٢٠١٧ at 11:56, عذاب الزمان said:

الكود بهذا الشكل يخرج لي نتيجة s17/00001   وهكذا صعودا  ...

هل يمكن اظهاره بالشكل  s2017/00001   وهكذا صعودا ؟؟؟ علما اني غيرت في السطر الرابع prtyr  الرقم 2 الى 4  وظهر لي ما اردت لكنه يبقى ثابتا بتسلسل 1 لجميع السجلات .

يا عذاب الزمان السلام عليكم ورحمة الله وبركاته
ما تريد بالضبط 
هل تريد ان يكون تسلسل التاريخ  هكذا s17/00001  ام هكذا s2017/00001

رأيت هذه المشاركة
ان استاذنا @jjafferr عطيتك ماتريد

 

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

السلام عليكم استاذي المحترم

اريد اما 

s2017/0001   ولا يتكرر رقم السجل  ، ويبدا برقم جديد بداية كل سنة .

او 

يظهر لي الترقيم  بشكل 1  للسجل الاول  و  2  للسجل الثاني   وهكذا ولا يتكرر  ، ويبدأ برقم جديد عند بداية سنة جديدة . 

اي

لا اريده بالصيغ  171 او 1701 او غيرها 

جزاكم الله خيرا .

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

  • 1 year later...

ماشاء الله استاذ ابو خليل 

عمل اكثر من رائع جعله في ميزان حسناتكم يوم العرض

 

سؤال :

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

 

بمعنى يكون تسلسل الطالب في الصف مقرون برقم الصف ويكون لكل صف تسلسل مستقل عن الصف الاخر

 

مودتي للجميع بالخير والسلام

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

  • 3 weeks later...
  • 4 months later...
4 ساعات مضت, ella3na said:

انا شاكر لك جداا بس اريد معرفه كيف يتم العمل علي تغير الترقيم التلقائي شهريا  و ليست سنويا 

 

في ٢٨‏/٣‏/٢٠١٧ at 06:59, ابوخليل said:

غير في هذا السطر فقط :


prtyr = Right(DatePart("yyyy", Date), 2)

ليصبح بعد التعديل هكذا :


prtyr = DatePart("d", Date)

 

اعتقد انه يمكن ايضا ان يتم التغيير شهريا جرب تغيير السطر في الاقتباس اعلاه الى

prtyr = DatePart("m", Date)

 

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

  • 7 months later...
On 7/24/2014 at 3:52 PM, ابوخليل said:

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

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

هل يمكن ان يكون الترقيم التلقائي يبقي كل شهر  يعني كل شهر يبداء الترقيم من الاول

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

في ١٩‏/٨‏/٢٠١٦ at 06:23, رمهان said:

وجدت لكم بالجعبة الفقيرة السطر التالي ولطلب الاخ محمد سلامة


Private Sub Form_BeforeInsert(Cancel As Integer)
ID = "S" & Replace(Nz(DMax("id", "tbl1", "id like 's" & Right(Year(Date), 2) & "*'"), "s" & Right(Year(Date), 2) & "00000"), "s", "") + 1
End Sub

كما يمكن وضع السطر السابق كقيمة افتراضية للعنصر وبدون كود 

بالتوفيق

 

جرب كود رمهان

وهكذا الشهر  (Month )

 

ID = "S" & Replace(Nz(DMax("id", "tbl1", "id like 's" & Right(Month(Date), 2) & "*'"), "s" & Right(Month(Date), 2) & "00000"), "s", "") + 1
  • Like 2
رابط هذا التعليق
شارك

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

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

Important Information