اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


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

السلام عليكم و رحمة الله و بركاته تقبل الله منا و منكم الصيام و القيام.

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

بدون إطالة أقدم لكم هذا الكود.

 

 

DoCmd.GoToRecord , , acFirst
Dim i As Integer
For i = 1 To 11
On Error Resume Next
Dim x, y As Integer
x = 1
If IsNull(x) Then
y = i
Else
y = y + 1
End If
Me![num] = Format(y, "0000")
On Error Resume Next
DoCmd.GoToRecord , , acNext
Next i

و هذا الملف يوضح ذلك.

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

إعادة ترقيم عمود في جدول.rar

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

15 ساعات مضت, صالح حمادي said:

السلام عليكم و رحمة الله و بركاته تقبل الله منا و منكم الصيام و القيام.

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

تقبل الله منا و منكم صالح الاعمال ...

 

 

تعديل بسيط ... 

DoCmd.GoToRecord , , acFirst
Dim i, d As Integer
d = DCount("*", "جدول1")
For i = 1 To d
On Error Resume Next
Dim x, y As Integer
x = 1
If IsNull(x) Then
y = i
Else
y = y + 1
End If
Me![num] = Format(y, "0000")
On Error Resume Next
DoCmd.GoToRecord , , acNext
Next i

 

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

شكرا للاستاذ صالح

وشكرا للاستاذ كرار

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

 هذا تعديل بسيط  للمرور على جميع السجلات داخل النموذج 

DoCmd.GoToRecord , , acFirst
Dim i As Integer
For i = 1 To Me.Recordset.RecordCount
On Error Resume Next
Dim x, y As Integer
x = 1
If IsNull(x) Then
y = i
Else
y = y + 1
End If
Me![num] = Format(y, "0000")
On Error Resume Next
DoCmd.GoToRecord , , acNext
Next i

 

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

الله عليكم رائع بس لو تخصصون نصف ساعة من وقتكم الثمين لتعليم المبتدئين من مثلي دروس vba (سلسلة تشرح كل يوم كود ) كود لا دوال الأكسس لأنها موجودة خاصة تراكيب الكود و بعض الرموز التي تأتي معه & " ' "'" ";" و شوف كم يضاعف الأجر للأسف نحن لم نجد معاهد تكوين متخصصة تمكننا من ذلك كل ما تعلمناه هو من الأنترنت لكن تبقى ناقصة و الكتب كلها إنجليزي فاياريت تبسط لنا الأمور حتى نتحكم فيها و يزول الغموض و الله أنا بغير منكم و في قلب حسرة أني لم أستطيع التقدم في هذا المجال و الله أنتم طوبى لكم و شكرا 

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

شكرا أستاذ كرار على التعديل المهم جدا.

شكرا أستاذ أبوخليل على الملاحظات القيمة.

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

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

لذلك أخي أنصحك بتعلم الخورزميات و لا تستعجل الأمور فسوف تجد نفسك مبرمجا بارعا بإذن الله الواحد القهار.

 

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

DoCmd.GoToRecord , , acFirst

هذا الكود للذهاب إلى السجل الأول من أجل بداية الترقيم من السجل رقم 1

Dim i As Integer

للتعريف بالمتغير i كعدد صحيح

d = DCount("*", "جدول1")
لحساب عدد سجلات الجدول
For i = 1 To d
تفيدنا في تكرار العملية
If IsNull(x) Then
y = i
Else
y = y + 1
End If

هذا الجزء من أجل إعطاء قيمة y=1 في البداية ثم في كل مرة نضيف 1

Me![num] = Format(y, "0000")

كتابة قيمة y على شكل 4 أرقام في مربع النص [num]

DoCmd.GoToRecord , , acNext
الذهاب إلى السجل التالي

إن شاء الله تكون إستفدت من هذا الشرح البسيط بالتوفيق

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information