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

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


amir_adam83
إذهب إلى أفضل إجابة Solved by kanory,

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

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

لدي كود الترقيم التلقائي وهو 

TextID = "AD." & Replace(Nz(DMax("TextID", "Table", "TextID like 'AD." & Right(Year(Date), 2) & "*'"), "AD." & Right(Year(Date), 2) & "000"), "AD.", "") + 1

وهو يعمل بصوره ممتازه ولكن

عند البداء 

AD.210001

AD.210002

AD.210003

AD.210004

AD.210005

AD.210006

AD.210007

AD.210008

وهو يعمل بصوره اكثر من رائعه

 ولكن عند حذف رقم 

AD.210003

واخر رقم متوقف عنده العد التلقائي هو

AD.210008

عند اضافة جديده ياتي برقم

AD.210009

واعتبر رقم

AD.210003

متواجد

اريده يتم البحث عن الارقام المفقوده

وياتي به وبعد هذا الرقم يبداء العد تلقائي

هل من طريقه

بارك الله فيكم

 

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

بارك الله فيك وجزاك الله خير الجزاء هذا بالفعل هو المطلوب 

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

مثل الصورة رقم واحد

وعند اضافة رقم صفر في البداية

ياتي بالترقيم الصحيح

وعند اضافة رقم 2 ياتي

بترقيم غير الترقيم رقم 1

 

 

NO1.jpg

رقم 2.jpg

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

استبدل الكود الموجود لديك بهذا الكود .....

On Error Resume Next
    Dim Db As DAO.Database
    Dim Rc As DAO.Recordset
    Dim ChequesFound
    Dim ChequeNoStart As Long
    Dim ChequeNoEnd As Long
    Dim i As Long
    Set Db = CurrentDb
    Set Rc = Db.OpenRecordset("SELECT SamoBrojevitxt([dbo_ID]) AS Brojevtxti FROM dbo_Tbl_Emp ORDER BY SamoBrojevitxt([dbo_ID]);")
    Do While Not Rc.EOF
        Rc.MoveNext
    Loop
    If Rc.RecordCount = 0 Then
       dbo_ID = "Em." & Right(Year(Date), 2) & "001"
        'MsgBox "No Records Found"
        GoTo cmdDisplay_Exit
    End If
    DoCmd.GoToRecord , "", acNewRec
    Rc.MoveFirst
    ChequesFound = Rc.GetRows(Rc.RecordCount)
    ChequeNoStart = ChequesFound(0, 0)
    ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2))
    For i = ChequeNoStart To ChequeNoEnd
         If BinarySearch(ChequesFound, i) = False Then
         
         dbo_ID = "Em." & i
         GoTo cmdDisplay_Exit
        Else
        
        dbo_ID = "Em." & Replace(Nz(DMax("dbo_ID", "dbo_Tbl_Emp", "dbo_ID like 'Em." & Right(Year(Date), 2) & "*'"), "Em." & Right(Year(Date), 2) & "000"), "Em.", "") + 1

        End If
    Next i
cmdDisplay_Exit:
    Set Rc = Nothing
    Set Db = Nothing
    

 

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

لكن لو فكرت منطقيا ...

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

اذن ... سوف تواجه مشكلة العام القادم ... ليش

منطقيا ان كل عام له ترقيمه الخاص ... يعني كل سنه يبدأ ترقيم من جديد .... 

السؤال ... لك .... للتعلم .... كيف يمكن تعديل الكود السابق حتى نتلافى تلك المشكلة ؟؟؟

اريد انت تفكر بطرق حل تلك المشكلة برمجيا !!

 

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

بالفعل قولك صحيح😃 استاذي الكريم  لكن انت استاذنا ونحن من هم يتعلمون منكم برك الله فيكم وجعلكم عونا لنا

تم تعديل تاريخ الكمبيوتر للعام المقبل 2022 بالفعل اتي لي EM.220010 ولم يعد من نقظة الصفر للعام الجديد

 

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

وجدت هذا الكود

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

في

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

اذا حذفت رقم

1 ورقم2ورقم3و

ياتي بالترقيم رقم اربعه

ولم ياتي برقم 1-2-3

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

 

dbo_da_ka11n.rar

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

لان الكود ينظر لاول تريقيم في الجدول وليس الترقيم الذي انت تريده ( بداية الترقيم قي السنه ) انظر هذا الكود وتفحصة لتعرف ما الذي يجب عليك تعديلة ليفهم الكود بداية الترقيم Em.21001

    DoCmd.GoToRecord , "", acNewRec
    Rc.MoveFirst
    ChequesFound = Rc.GetRows(Rc.RecordCount)
    ChequeNoStart = ChequesFound(0, 0)
    ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2))

اما الكود الذي وجدته فلا يعيد الارقام المفقودة !!!!!

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

السلام عليكم استاذي الكريم @kanory

تم وضع وتعديل الكود

 

DoCmd.GoToRecord , "", acNewRec
    Rc.MoveFirst
    ChequesFound = Rc.GetRows(Rc.RecordCount)
    ChequeNoStart = ChequesFound(0, 0)
    ChequeNoEnd = ChequesFound(0, UBound(ChequesFound, 2))

ولكن المشكله تكمن كما هي ولا يوجد جديد

اولا: عند التحويل لعام جديد ياتي باول كود فقطEm.21001

وعند اضافة موظف جديد في نفس العام ياتيEm.20008

رغم اني اعمل بعام 2021

ثانيا

لا يستطيع الفصل بين العام الماضي والحالي

بعتذر على الاطالة في مساعدتي بارك الله فيكم

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

2 hours ago, kanory said:

طيب ...

جرب المرفق ووافينا بالنتيجة ...

 

dbo_da_kan.accdb 552 kB · 1 download

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

الله يعطيك الف عافية

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

تم اختبار حذف ارقام بعد رقم 1

وتم اعادة الترقيم للاقام التى تم حذفها

 

وتم اختباره على عام جديد يعمل بصوره مائه بالمائه

وهذا مايطلبه الكثير

لعله في ميزان حسناتك ان شاء الله

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

شكرا جزيل

 

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

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



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

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

Important Information