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

تنفيذ دالة DMax من جدولين معاً


mr steev

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

السلام عليكم

في قاعدة البيانات المرفقة :

أريد التعديل على الكود التالي في زر أمر ترقيم عند النقر المزدوج :

 

Private Sub Cmd0_DblClick(Cancel As Integer)
    BornNo = Nz(DMax("[EarNo]", "AnimalsRecords" Or "BornsRecords", "[CowNo]=  form![CowNo] and [Season]=form![Season]"), 0) + 1
End Sub

وذلك ليقوم الكود بجعل قيمة الحقل BornNo تساوي (أعلى رقم في الحقل EarNo من الجدولين AnimalsRecords و BornsRecords) مضاف إليه 1

 

أو افادتنا بطريقة أخرى برمجيا لتنفيذ الأمر

 

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

DMax function two table.rar

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

وعليكم السلام  :smile:

 

ما يصير Dsum من الجدولين في خطوة واحدة   :eek2:

 

لازم تطلب الرقم الاعلى من الجدول الاول ،

ثم الرقم الاعلى من الجدول الثاني ،

ثم تقارن بين الرقمين ، وتختار الاعلى ، ثم تضيف اليه 1  :smile:

 

 

جعفر

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

وهذا هو الكود:

Private Sub Cmd0_DblClick(Cancel As Integer)

    'BornNo = Nz(DMax("[EarNo]", "AnimalsRecords" Or "BornsRecords", "[CowNo]=  form![CowNo] and [Season]=form![Season]"), 0) + 1
    'A = DMax("[EarNo]", "AnimalsRecords", "[CowNo]=" & Me.CowNo & " and [Season]=" & Me.Season)
    
    'check if BornNo is in the Record
    If Len(Me.BornNo & "") <> 0 Then
        
        Dim Msg, Style, Response
        Msg = "Ear Number already exists in this Record, Do you want to over write?"
        Style = vbYesNo + vbCritical + vbDefaultButton2    ' Define buttons.

        Response = MsgBox(Msg, Style)
        If Response = vbYes Then
        
            ' User chose Yes, over write
            A = Nz(DMax("[EarNo]", "AnimalsRecords"), 0) + 1
            B = Nz(DMax("[EarNo]", "BornsRecords"), 0) + 1
    
            BornNo = A
            If B > BornNo Then BornNo = B
        Else
        
            ' User chose No.
            Exit Sub
        End If
    End If
    
End Sub

جعفر

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

مشاركة مع الأستاذ جعفر

اعمل استعلام جديد وباسم qr1  ومصدره الجملة التالية:

select DISTINCT [AnimalsRecords].[EarNo] from [AnimalsRecords] UNION select DISTINCT [BornsRecords].[SeasonalNo] from [BornsRecords];

وهذا الكود :

Private Sub Cmd0_DblClick(Cancel As Integer)
    BornNo = Nz(DMax("[EarNo]", "qr1"), 0) + 1
End Sub

اخي ابوخليل : كذلك انت لم ترد وتناقش هنا

 

http://www.officena.net/ib/index.php?showtopic=60209&hl=

 

تحياتي

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

مشاركة مع الأستاذ جعفر

اعمل استعلام جديد وباسم qr1  ومصدره الجملة التالية:

select DISTINCT [AnimalsRecords].[EarNo] from [AnimalsRecords] UNION select DISTINCT [BornsRecords].[SeasonalNo] from [BornsRecords];

وهذا الكود :

Private Sub Cmd0_DblClick(Cancel As Integer)
    BornNo = Nz(DMax("[EarNo]", "qr1"), 0) + 1
End Sub

اخي ابوخليل : كذلك انت لم ترد وتناقش هنا

 

http://www.officena.net/ib/index.php?showtopic=60209&hl=

 

تحياتي

 

طريقة جميلة أخي رمهان  :smile:

 

 

 

جعفر

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

حياك الله أخوي أبوخليل  :smile:

 

وربي يحييك اخوي جعفر

 

 

اخي ابوخليل : كذلك انت لم ترد وتناقش هنا

 

http://www.officena....wtopic=60209=

  العفو ...  ما علمت بها غير الساعة   :blink:

وقد كتبت الرد هناك 

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

على بركة الله  :smile:

 

بس لازم تتأكد ان حقل BornNo لا يحتوي على رقم ، وإلا فإنك ستكتب عليه الرقم الجديد :eek2:

لهذا السبب استخدمت كود للتأكد بان الحقل فاضي ، واذا ما كان فاضي ، فالكود يسألك اذا كنت تريد تغيره  :smile:

 

هذا بداية الكود (الكود الكامل موجود في مشاركتي رقم 5):

'check if BornNo is in the Record
    If Len(Me.BornNo & "") <> 0 Then

جعفر

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

ومع الاستاذ جعفر بهذه الملاحظة

ويمكن باستخدام فحص ان السجل جديد وباستخدام

if me.newrecord then

بالتوفيق

  • 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