مشكلة في الترقيم التلقائي في النموذج

[nacer_alger]

سلام عليكم

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

 

 

[كريمو2]

إنسخ هذا في مربع نص الترقيم التلقائي طبعا إذا كان مربع النص التلقائي اسمه ID 

=RcNum([Form];"ID";[ID])

ثم انسخ الكود هذا في الوحدة النمطية

Function RcNum(frm As Form, fldName As String, mID As Variant) As Variant
Dim RstClone As Recordset
Dim Fld As Field
Dim I As Long
RcNum = Null
If IsNull(mID) Then Exit Function
Set RstClone = frm.RecordsetClone
If RstClone.RecordCount = 0 Then Exit Function
Set Fld = RstClone.Fields(fldName)
With RstClone
.MoveFirst
Do Until .EOF
I = I + 1
If Fld = mID Then Exit Do
.MoveNext
Loop
End With
RstClone.Close
RcNum = I
End Function

تم تعديل أغسطس 10, 2014 بواسطه كريمو2

[علي المصري]

إذا كان النموذج في وضع  Single Form  يمكنك كتابة   =[CurrentRecord]    في مصدر بيانات الحقل الخاص بالترقيم

[علي المصري]

 

إنسخ هذا في مربع نص الترقيم التلقائي طبعا إذا كان مربع النص التلقائي اسمه ID 

=RcNum([Form];"ID";[ID])

ثم انسخ الكود هذا في الوحدة النمطية

Function RcNum(frm As Form, fldName As String, mID As Variant) As Variant
Dim RstClone As Recordset
Dim Fld As Field
Dim I As Long
RcNum = Null
If IsNull(mID) Then Exit Function
Set RstClone = frm.RecordsetClone
If RstClone.RecordCount = 0 Then Exit Function
Set Fld = RstClone.Fields(fldName)
With RstClone
.MoveFirst
Do Until .EOF
I = I + 1
If Fld = mID Then Exit Do
.MoveNext
Loop
End With
RstClone.Close
RcNum = I
End Function

استاذ كريمو

عند تنفيذ الوظيفة كانت النتيجة يوجد خطأ

وهو موضح بالصورة المرفقة

فما الحل

 

[nacer_alger]

شكرا اخي كريمو و علي المصري

لكن الكود الخاص بوحدة النمطية في اي خصية اضعه عند ضغط

[كريمو2]

شكرا اخي كريمو و علي المصري

لكن الكود الخاص بوحدة النمطية في اي خصية اضعه عند ضغط

انظر المرفق وجرب حذف سجل من السجلات

 

2014.rar

[علي المصري]

بدون واحدات نمطية نستخدم فقط   

 

=[currentRecord]

انظر المرفق

2014.rar

[بـ عبدالله ـو]

شكراً لكم على هذه المعلومة

[nacer_alger]

شكرا لك اخي على المساعدة

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

[محمود أبوسيف]

أخي الكريم

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

=[currentRecord] بمجرد الوصول إلي آخر سجل والإنتقال إلي السجل الأول يصبح رقم أول سجل هو نفس رقم  أخر سجل . ليس كذلك فقط بل بمجرد الخروج من النموذج والعودة مرة أخري أجد أن جميع السجلات تحصل علي الرقم 1 

وعندما جربت =RcNum([Form];"ID";[ID]) ثم أدخلت الكود في الوحدة النمطية كما أشرت سابقاً فكانت النتيجة #Name? . فما الحل

ملحوظة . النموذج الذي لدي ليس به جدول ID أو جدول ترقيم تلقائي . وللأسف قاعدة البيانات حجمها كبير ولاأستطيع رفعها . ولكن سوف أرفع صور لهذه المشكلة

ترقيم تلقائي.rar

[ابو جودي]

Mahmoud330

ممكن ارفاق مثال للاطلاع عليه يا استاذ محمود

[محمود أبوسيف]

السلام عليكم

لدي نموذج  ليس به جدول ID أو جدول ترقيم تلقائي . وأريد عمل ترقيم تلقائي داخل النموذج دون أن يكون له جدول

 

للدخول إلي النموذج المراد التعديل عليه ( نضعط علي   OK   ثم     نصف العام     ثم      إدخال الإنجاز نصف العام )

 

وهذا هو رابط الملف

http://www.4shared.com/rar/x0B-o3ULce/__2015_.html

[محمود أبوسيف]

Mahmoud330

ممكن ارفاق مثال للاطلاع عليه يا استاذ محمود

لقد قمت بإرفاق الملف نفسه

 

لتجهيز الانجاز 2015 .rar

[علي المصري]

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

 

اشكر كل من ساهم في الموضوع من السادة الاعضاء لكم جزيل الشكر

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

 

شكرا جزيلا وجزاكم الله خير

 

 

إليكم الدلة التالية لعمل ترقيم تلقائي في النموذج  ( العمل ليس لي ولكنه نتيجة بحث على الانترنت واستخدمته واتي بالنتيجة المطلوبة ) ( للأمانة العلمية )

اكتب مصدر الحقل المراد الترقيم فيه كما يلي 
=RowNum([Forms]![Data])
حيث
 data
  هو اسم النموذج


ضع الدالة التالية في موديول جديد
Public Function RowNum(frm As Form) As Variant
 On Error GoTo Err_RowNum
     'Purpose:   Numbering the rows on a form.
     'Usage:     Text box with ControlSource of:  =RowNum([Forms]![theNameoftheForm])

     With frm.RecordsetClone
         .Bookmark = frm.Bookmark
         RowNum = .AbsolutePosition + 1
     End With

Exit_RowNum:
     Exit Function

Err_RowNum:
     If Err.Number <> 3021& Then  'Ignore "No bookmark" at new row.
        Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description
     End If
     RowNum = Null
    Resume Exit_RowNum
 End Function

[محمود أبوسيف]

 

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

 

اشكر كل من ساهم في الموضوع من السادة الاعضاء لكم جزيل الشكر

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

 

شكرا جزيلا وجزاكم الله خير

 

 

إليكم الدلة التالية لعمل ترقيم تلقائي في النموذج  ( العمل ليس لي ولكنه نتيجة بحث على الانترنت واستخدمته واتي بالنتيجة المطلوبة ) ( للأمانة العلمية )

اكتب مصدر الحقل المراد الترقيم فيه كما يلي 
=RowNum([Forms]![Data])
حيث
 data
  هو اسم النموذج


ضع الدالة التالية في موديول جديد
Public Function RowNum(frm As Form) As Variant
 On Error GoTo Err_RowNum
     'Purpose:   Numbering the rows on a form.
     'Usage:     Text box with ControlSource of:  =RowNum([Forms]![theNameoftheForm])

     With frm.RecordsetClone
         .Bookmark = frm.Bookmark
         RowNum = .AbsolutePosition + 1
     End With

Exit_RowNum:
     Exit Function

Err_RowNum:
     If Err.Number <> 3021& Then  'Ignore "No bookmark" at new row.
        Debug.Print "RowNum() error " & Err.Number & " - " & Err.Description
     End If
     RowNum = Null
    Resume Exit_RowNum
 End Function

أ/ علي  لقد جربت مثلما قلت تماما ولكن لم تنجح هذه الطريقة معي فهل من الممكن أن تقوم حضرتك بالتعديل علي الملف وإعادة رفعة مرة آخري

[علي المصري]

مثال على الكود

AliElmasry.rar

[محمود أبوسيف]

مثال على الكود

أخي الفاضل الأستاذ /

علي المصري   أولاً . هذا المرفق AliElmasry.rar لايعمل

ثانياً :- هل الممكن أن تقوم بتنفيذ هذا الكود علي هذا الملف

لتجهيز الانجاز 2015 .rar

 

المطلوب تنفيذ الكود والدالة علي النموذج ( إدخال الإنجال نصف العام )

[علي المصري]

الكود يعمل جيدا عندي

وانا بستخدمه في قاعدة بيانات منذ أربعة أشهر

 

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

دائما تظهر رسالة انه هناك خطأ في vba للفورم

ولا ادري كيف حلها

 

حاول تجرب الكود على فورم جديد بعيد قاعدة البيانات الخاصة بك أولا للتأكد من ان الكود يعمل ام لا

 

الملف الخاص بي سوف ارفقه مرة ثانية اختار grade 10   ثم section A

 

 

AliElmasry.rar

[محمود أبوسيف]

الكود يعمل جيدا عندي

وانا بستخدمه في قاعدة بيانات منذ أربعة أشهر

 

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

دائما تظهر رسالة انه هناك خطأ في vba للفورم

ولا ادري كيف حلها

 

حاول تجرب الكود على فورم جديد بعيد قاعدة البيانات الخاصة بك أولا للتأكد من ان الكود يعمل ام لا

 

الملف الخاص بي سوف ارفقه مرة ثانية اختار grade 10   ثم section A

 

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

[علي المصري]

الملف المرفق تنسيق اكسيس 2007 - 2013

[محمود أبوسيف]

أنا بستخدم 2003 ، 2007

[abohasan911]

جزاكم الله كل خير يا اخوان مبدعين ما شاء الله لا قوة إلا بالله