محاولة انشاء دالة

كوماندير · مايو 5, 2017

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

الافاضل الكرام لدي ثلاثة نماذج :

MainFrm وبداخله OrdersSubFrm وبداخله OrdDetSubFrm

وكان لدي الكود التالي تحت حدث قبل التحديث للنموذج MainFrm

if Me!OrdersSubFrm.Form.RecordsetClone.RecordCount > 0 Then

Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String

MyDate = DateSerial(Year(Me!OrdersSubFrm.Form!OrderDate), Month(Me!OrdersSubFrm.Form!OrderDate), Day(Me!OrdersSubFrm.Form!OrderDate))
LValue = DateDiff("d", MyDate, Date)

If LValue < 10 Then
MnthCnt = "íæã"
Else
MnthCnt = "íæãÇð"
End If
If LValue >= 3 Then
   If MsgBox("ÚÒíÒí ÇáãÓÊÎÏã áÞÏ ãÖÊ ÃßËÑ ãä " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
   "ãä ÊÇÑíÎ åÐå ÇáÒíÇÑÉ ááãÑíÖ   :" & "" & Me.PtName & vbCrLf & _
     "åá ÊÑíÏ ÝÚáÇ ÇáÊÛííÑ Ýí ãÚáæãÇÊ åÐÇ ÇáãÑíÖ ÈÚÏ ãÖí åÐå ÇáÝÊÑå ...  áÊÃßíÏ ÇáÊÛííÑ ÇÎÊÑ äÚã  ¡ áÇáÛÇÁ ÇáÊÛííÑ ÇÎÊÑ áÇ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " ÊÃßíÏ ÊÚÏíá " & " " & Me.PtName) = vbYes Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If
End If
End If

والكود التالي تحت قبل التحديث للنموذج OrdersSubFrm

Dim MyDate

Dim LValue As Integer
Dim MnthCnt As String

MyDate = DateSerial(Year(Me!OrderDate), Month(Me!OrderDate), Day(Me!OrderDate))
LValue = DateDiff("d", MyDate, Date)

If LValue < 10 Then
MnthCnt = "íæã"
Else
MnthCnt = "íæãÇð"
End If




If LValue >= 3 Then
   If MsgBox("ÚÒíÒí ÇáãÓÊÎÏã áÞÏ ãÖÊ " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
     "ãä ÊÇÑíÎ åÐå ÇáÒíÇÑÉ ááãÑíÖ :" & "" & Me.Parent.PtName & vbCrLf & _
     "åá ÊÑíÏ ÝÚáÇ ÇáÊÛííÑ Ýí ãÚáæãÇÊ åÐÇ ÇáãÑíÖ ÈÚÏ ãÖí åÐå ÇáÝÊÑå  ...  áÊÃßíÏ ÇáÊÛííÑ ÇÎÊÑ äÚã  ¡ áÇáÛÇÁ ÇáÊÛííÑ ÇÎÊÑ áÇ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " ÊÃßíÏ ÊÚÏíá " & " " & Me.Parent!PtName) = vbYes Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If

End If

والكود التالي تحت قبل التحديث للنموذج OrdDetSubFrm

Dim MyDate

Dim LValue As Integer
Dim MnthCnt As String

MyDate = DateSerial(Year(Me.Parent!OrderDate), Month(Me.Parent!OrderDate), Day(Me.Parent!OrderDate))
LValue = DateDiff("d", MyDate, Date)

If LValue < 10 Then
MnthCnt = "íæã"
Else
MnthCnt = "íæãÇð"
End If




If LValue >= 3 Then
   If MsgBox("ÚÒíÒí ÇáãÓÊÎÏã áÞÏ ãÖÊ " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
   "ãä ÊÇÑíÎ åÐå ÇáÒíÇÑÉ ááãÑíÖ    :" & " " & Me.Parent.Parent!PtName & vbCrLf & _
     "åá ÊÑíÏ ÝÚáÇ ÇáÊÛííÑ Ýí ãÚáæãÇÊ åÐÇ ÇáãÑíÖ ÈÚÏ ãÖí åÐå ÇáÝÊÑå  ...  áÊÃßíÏ ÇáÊÛííÑ ÇÎÊÑ äÚã  ¡ áÇáÛÇÁ ÇáÊÛííÑ ÇÎÊÑ áÇ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " ÊÃßíÏ ÊÚÏíá " & " " & Me.Parent.Parent!PtName) = vbYes Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If

End If

وبدلا من تكرار الكود قمت باءنشاء الوظيفة التالية ولكن لانها المحاولة الاولى لانشاء وظيفة فقد احببت رأيكم حتى لا اقع في اخطاء (برغم انها اشتغلت معي كما ارجو ):

Option Compare Database

Option Explicit
Public Function LTDYS(LftDate As Date, MyPtNm As String)


Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String

MyDate = DateSerial(Year(LftDate), Month(LftDate), Day(LftDate))
LValue = DateDiff("d", MyDate, Date)

If LValue < 10 Then
MnthCnt = "íæã"
Else
MnthCnt = "íæãÇð"
End If
If LValue >= 3 Then
   If MsgBox("ÚÒíÒí ÇáãÓÊÎÏã áÞÏ ãÖÊ ÃßËÑ ãä " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
   "ãä ÊÇÑíÎ åÐå ÇáÒíÇÑÉ ááãÑíÖ   :" & "" & MyPtNm & vbCrLf & _
     "åá ÊÑíÏ ÝÚáÇ ÇáÊÛííÑ Ýí ãÚáæãÇÊ åÐÇ ÇáãÑíÖ ÈÚÏ ãÖí åÐå ÇáÝÊÑå ...  áÊÃßíÏ ÇáÊÛííÑ ÇÎÊÑ äÚã  ¡ áÇáÛÇÁ ÇáÊÛííÑ ÇÎÊÑ áÇ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " ÊÃßíÏ ÊÚÏíá " & " " & MyPtNm) = vbNo Then
    ' MyCancel = False
    ' Else
    ' MyCancel = True
     DoCmd.RunCommand acCmdUndo
     Else
     Exit Function
     End If
End If
Exit Function

End Function

راجو افادتكم ووضع ملاحظاتكم .

كوماندير · مايو 12, 2017

الاعزاء الكرام للاهمية

وبما ان الرسالة لاتظهر جيدا لانها باللغة العربية فقد قمت بتحويل الرسالة الى الانجليزية :

عندي ثلاثة نماذج :

MainFrm

وبداخله OrdersSubFrm

وبداخله OrdDetSubFrm

المشكله لدي هي :اريد رساله تنبه المستخدم عند محاولته تغيير اي من بيانات الثلاثة النماذج

بعد مرور ثلاثة ايام من تاريخ اليوم الحالي .

طبعا في كل الاكواد استخدم الحقل OrderDate الموجود بالنموذج الفرعي OrdersSubFrm ومقارنته بتاريخ اليوم .

ولكن لانني مضطر لاعادة كتابة الكود في كل نموذح (قبل التحديث ) اريد انشاء كود وحيد ويتم استدعائه في كل النماذج .

الكود نفسه تقريبا مكرر بنفس النماذج ماعدا السطر :

'In MainFrm

MyDate = DateSerial(Year(Me!OrdersSubFrm.Form!OrderDate), Month(Me!OrdersSubFrm.Form!OrderDate),Day(Me!OrdersSubFrm.Form!OrderDate))

'in the OrdersSubFrm (sub form):

MyDate = DateSerial(Year(Me!OrderDate), Month(Me!OrderDate), Day(Me!OrderDate))

' in the OrdDetSubFrm (sub sub form) :

MyDate = DateSerial(Year(Me.Parent!OrderDate), Month(Me.Parent!OrderDate), Day(Me.Parent!OrderDate))

لدي الكود التالي تحت حدث قبل التحديث للنموذج MainFrm

Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String

MyDate = DateSerial(Year(Me!OrdersSubFrm.Form!OrderDate), Month(Me!OrdersSubFrm.Form!OrderDate), Day(Me!OrdersSubFrm.Form!OrderDate))
LValue = DateDiff("d", MyDate, Date)

If LValue < 10 Then
MnthCnt = "day"
Else
MnthCnt = "days"
End If
If LValue >= 3 Then
   If MsgBox("Dear user It has been " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
   " from the date of this visit for patient:" & "" & Me.PtName & vbCrLf & _
     "Do you want to change the information of this patient, to confirm the changes Choose Yes, to cancel select No. ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " Change Confirmation " & " " & Me.Parent!PtName) = vbYes Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If
End If
End If

والكود التالي في OrdersSubFrm (sub form)

Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String
MyDate = DateSerial(Year(Me!OrderDate), Month(Me!OrderDate), Day(Me!OrderDate))
LValue = DateDiff("d", MyDate, Date)
If LValue < 10 Then
MnthCnt = "day"
Else
MnthCnt = "days"
End If
If LValue >= 3 Then
   If MsgBox("Dear user It has been " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
     " from the date of this visit for patient:" & "" & Me.Parent.PtName & vbCrLf & _
     " Do you want to change the information of this patient, to confirm the changes Choose Yes, to cancel select No. ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " Change Confirmation " & " " & Me.Parent!PtName) = vbYes Then Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If

End If

والكود التالي في OrdDetSubFrm (sub sub form)

Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String
MyDate = DateSerial(Year(Me.Parent!OrderDate), Month(Me.Parent!OrderDate), Day(Me.Parent!OrderDate))
LValue = DateDiff("d", MyDate, Date)
If LValue < 10 Then
MnthCnt = "day"
Else
MnthCnt = "days"
End If
If LValue >= 3 Then
   If MsgBox("Dear user It has been " & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
   " from the date of this visit for patient:" & " " & Me.Parent.Parent!PtName & vbCrLf & _
     " Do you want to change the information of this patient, to confirm the changes Choose Yes, to cancel select No. ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " Change Confirmation " & " " & Me.Parent!PtName) = vbYes Then
     Cancel = False
     Else
     Cancel = True
     DoCmd.RunCommand acCmdUndo
     End If
End If

ولدي مربع قائمة في النموذج :OrdersSubFrm (sub form)

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

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

Dim MyDate
Dim LValue As Integer
Dim MnthCnt As String
MyDate = DateSerial(Year(Me!OrderDate), Month(Me!OrderDate), Day(Me!OrderDate))
LValue = DateDiff("d", MyDate, Date)
If LValue < 10 Then
MnthCnt = "day"
Else
MnthCnt = "days"
End If
If LValue >= 3 Then
   If MsgBox("Dear user It has been" & " ( " & LValue & " ) " & MnthCnt & vbCrLf & _
     "from the date of this visit for this patient :" & "" & Me.Parent.PtName & vbCrLf & _
     "Do you want to change the information of this patient, to confirm the changes Choose Yes, to cancel select No. ", vbInformation + vbMsgBoxRtlReading + vbMsgBoxRight + vbYesNo, " Change Confirmation " & " " & Me.Parent!PtName) = vbYes Then
      Cancel = False
      DoCmd.SetWarnings False
      DoCmd.OpenQuery "Q4"
      DoCmd.SetWarnings True
      Me!OrdDetSubFrm.Form.Requery

     Else
     Cancel = True

     End If
     Else
   DoCmd.SetWarnings False
  DoCmd.OpenQuery "Q4"
   DoCmd.SetWarnings True
  Me!OrdDetSubFrm.Form.Requery
End If

ارجو مساعدتي في تنفيذ function or sub

للقيام بعمل كل هذه الاكواد .

**أبو إبراهيم الغامدي** · مايو 12, 2017

3 ساعات مضت, كوماندير said:

ارجو مساعدتي في تنفيذ function or sub

للقيام بعمل كل هذه الاكواد .

أنت على الطريق الصحيح والوظيفة التي أنشأتها 90% لكن تحتاج إلى تبسيط بعض الشيء.. فقط اتبع الخطوات التالية

قم بنقل الوظيفة إلى وحدة نمطية عامة إذا لم تكن كذلك

غير السطر الأول إلى التالي

// لاحظ أنا غيرنا نوع البيانات إلى متنوع بدلا من تاريخ، ثم جعلنا الوظيفة تعيد قيمة منطقية
Public Function LTDYS(LftDate As Variant, MyPtNm As String) As Boolean

احذف السطر التالي

// البيانات من نوع تاريخ تعيد سلسلة طويلة من التاريخ والوقت
//  DateSerial() ولذلك لجأت إلى 
MyDate = DateSerial(Year(LftDate), Month(LftDate), Day(LftDate))

غير السطر التالي

// البيانات من نوع متنوع تعيد التاريخ كما هو وبالتالي لا حاجة إلى إعادة تركيبه
//LValue = DateDiff("d", MyDate, Date)
 LValue = DateDiff("d", LftDate, Date)

غير الأسطر التالية

 // MyCancel = False
 // Else
 // MyCancel = True
 // DoCmd.RunCommand acCmdUndo
 
// False إذا كانت الإجابة العائدة من الرسالة تكون القيمة الراجعة من الوظيفة
	LTDYS = False
Else
// True وإذا كانت نعم تكون القيمة الراجعة
	LTDYS = True

انتهت الوظيفة.. والقيمة الراجعة تسند إلى متغير الحدث قبل التحديث كا التالي

// في حدث قبل التحديث
// في نظري المتغير الثاني زائد
Cancel=LDays(Me.YourDate,MyPtNm)

هناك أشياء في الوظيفة لا تدعم الفكرة التي ذكرتها في مشاركتك؛ ولذلك تجاهلتها.. إذا كنت ترى أنها ضرورية قم بتفسيرها

تم تعديل مايو 12, 2017 بواسطه أبو إبراهيم الغامدي

كوماندير · مايو 13, 2017

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

اشكرك كثيرا على بذل وقتك وجهدك ثانية ....

الكود الذي تفضلت سيادتك بالتعديل عمل جيدا ... ( كما هو متوقع بالطبع .... )

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

فقد استدعيت الوظيفه تحت حدث النقرنقرتين لمربع القائمة آنف الذكر كالتالي :

If LTDYS(Me.OrderDate, Me.Parent.PtName) = True Then
    Cancel = True
    Exit Sub
Else
Cancel = False
     DoCmd.SetWarnings False
     DoCmd.OpenQuery "Q3"
     DoCmd.SetWarnings True
     Me!OrdDetSubFrm.Form.Requery
     Me.ListOne.Requery
End If

وكانت النتيجة كما كنت ارجوها .

Solved

تسجيل الدخول

محاولة انشاء دالة

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

كوماندير

كوماندير

أبو إبراهيم الغامدي

كوماندير

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information