محمد أبوعبدالله

وعليكم السلام ورحمة الله وبركاته المثال يعمل على اوفيس 365 بدون مشاكل عموماً اضف الكود التالي في بداية الكود Dim db As Object Set db = CurrentDb ثم استبدل Set Rs = CurrentDb.OpenRecordset("SELECT * FROM tblResult WHERE (tblResult.EmpID)= " & [Forms]![frmResult]![EmpID]) بالنالي Set Rs = db.OpenRecordset("SELECT * FROM tblResult WHERE (tblResult.EmpID)= " & [Forms]![frmResult]![EmpID]) الكود كاملاً Private Sub btnTest_Click() DoCmd.RunCommand acCmdSaveRecord Dim db As Object Set db = CurrentDb Dim i As Long, k As Long, m As Long Dim Rs As DAO.Recordset DoCmd.SetWarnings False m = 0 Set Rs = db.OpenRecordset("SELECT * FROM tblResult WHERE (tblResult.EmpID)= " & [Forms]![frmResult]![EmpID]) Rs.MoveLast k = Rs.RecordCount Rs.MoveFirst For i = 1 To k If Not (Rs!DawraEnd < Me.DawraStart Or Rs!DawraStart > Me.DawraEnd) Then m = m + 1 End If Rs.MoveNext Next i If m > 1 Then MsgBox "التاريخ متداخل مع تاريخ دورة اخرى" Else MsgBox "التاريخ سليم" End If Set Rs = Nothing DoCmd.SetWarnings True End Sub اذا لم يتم حل المشكلة برجاء اظهار الخطأ وتحديد اين المشكلة بالضبط تحياتي

بالتوفيق اخي الكريم وبارك الله فيك تحياتي

تفضل اخي الكريم تم اضافة معيار رقم الفاتورة forms!frm_search!txtsearch ليصبح الكود كاملاً كالتالي DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE tbl_Items SET tbl_Items.iAmount = [iAmount]*-1 WHERE (((tbl_Items.iAmount)>0) AND ((tbl_Items.iBill_Number)=[forms]![frm_search]![txtsearch]));" DoCmd.SetWarnings True MsgBox "تم تحويل جميع الارقام الموجبة الى سالبة", vbInformation DATA14.rar تحياتي

تفضل اخي الكريم DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE tbl_Items SET tbl_Items.iAmount = [iAmount]*-1 WHERE (((tbl_Items.iAmount)>0));" DoCmd.SetWarnings True MsgBox "تم تحويل جميع الارقام الموجبة الى سالبة", vbInformation DATA14.rar تحياتي

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام استعلام تحديث ككا البصورة الموضحة ملاحظة : وضعت علامة اكبر من صفر حتى ينفذ العمليات على الارقام الموجبة فقط وتجاهل ما هو سالب في الاصل تحياتي

تفضل اخي الكريم حسب ما فهمت من طلبك انك تريد اذا اخترت عنصر من comb1 يختفي من comb2 واذا اخترت عنصر من comb2 يختفي من comb1 tst.rar جرب واعلمني بالنتيجة تحياتي

بالمثال يتضح المقال برجاء ارفاق مثال للتعديل عليه تحياتي

وعليكم السلام ورحمة الله وبرماته تفضل اخي الكريم Private Sub Command33_Click() If Me.XFrame = 1 Then Me.d2 = Me.PaymentDate Me.n1 = DateDiff("d", [d1], [d2]) Else Me.d2 = DateAdd("d", 30, [PaymentDate]) Me.n1 = DateDiff("d", [d1], [d2]) End If End Sub Private Sub XFrame_Click() Call Command33_Click End Sub Database12021.rar تحياتي

وعليكم السلام ورحمة الله وبركاته مصادر شرح الدوال كثيرة جدا ما شاء الله منها هذا الموقع به شرح مبسط ولكن الاهم ان يكون مع الشرح تطبيق عملي فعليك تطبيق كل ما تتعلمه حتى يثبت باذن الله تحياتي

وعليكم السلام ورحمة الله وبركاته تم انشاء جدول tblWorkplace وربطه بجدول tbl_fbi وجدول tbl_User وتم وضع كود التحقق في النموذج If IsNull(Me.commu) Then MsgBox "فضلاً يجب أن تقوم بإدخال مكان العمل", vbInformation Me.user.SetFocus Exit Sub End If الصلاحيات المستخدمين (1).rar تحياتي

نعم يمكن اخي الكريم قم بتعديل الوحدة النمطية كالتالي Public Function Diff2Dates(interval As String, Date1 As Date, Date2 As Date, Optional ShowZero As Boolean = False) As Variant On Error GoTo Err_Diff2Dates Dim booCalcYears As Boolean Dim booCalcMonths As Boolean Dim booCalcDays As Boolean Dim booSwapped As Boolean Dim dtTemp As Date Dim intCounter As Integer Dim lngDiffYears As Long Dim lngDiffMonths As Long Dim lngDiffDays As Long Dim varTemp As Variant Const INTERVALs2 As String = "ddmmyyyy" interval = LCase$(interval) For intCounter = 1 To Len(interval) If InStr(1, INTERVALs2, Mid$(interval, intCounter, 1)) = 0 Then Exit Function End If Next intCounter If Not (IsDate(Date1)) Then Exit Function If Not (IsDate(Date2)) Then Exit Function If Date1 > Date2 Then dtTemp = Date1 Date1 = Date2 Date2 = dtTemp booSwapped = True End If Diff2Dates = Null varTemp = "" booCalcYears = (InStr(1, interval, "yyyy") > 0) booCalcMonths = (InStr(1, interval, "mm") > 0) booCalcDays = (InStr(1, interval, "dd") > 0) If booCalcYears Then lngDiffYears = Int(DateDiff("yyyy", Date1, Date2)) - IIf(Format$(Date1, "mm") <= Format$(Date2, "mm"), 0, 1) Date1 = DateAdd("yyyy", lngDiffYears, Date1) End If If booCalcMonths Then lngDiffMonths = Int(DateDiff("m", Date1, Date2)) - IIf(Format$(Date1, "dd") <= Format$(Date2, "dd"), 0, 1) Date1 = DateAdd("m", lngDiffMonths, Date1) End If If booCalcDays Then lngDiffDays = Int(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1, "hh") <= Format$(Date2, "hh"), 0, 1) Date1 = DateAdd("d", lngDiffDays, Date1) End If If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then varTemp = lngDiffYears & IIf(lngDiffYears <> 1, ".", ".") End If If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then If booCalcMonths Then varTemp = varTemp & IIf(IsNull(varTemp), Null, "") & _ lngDiffMonths & IIf(lngDiffMonths <> 1, "", "") End If End If ' If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then ' If booCalcDays Then ' varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _ ' lngDiffDays & IIf(lngDiffDays <> 1, " .", " .") ' End If ' End If If booSwapped Then varTemp = "-" & varTemp End If Diff2Dates = Trim$(varTemp) End_Diff2Dates: Exit Function Err_Diff2Dates: Resume End_Diff2Dates End Function تحياتي

وعليكم السلام ورحمة الله وبركاته ضع الكود التالي في وحدة نمطية جديدة Option Compare Database Public Function Diff2Dates(interval As String, Date1 As Date, Date2 As Date, Optional ShowZero As Boolean = False) As Variant On Error GoTo Err_Diff2Dates Dim booCalcYears As Boolean Dim booCalcMonths As Boolean Dim booCalcDays As Boolean Dim booSwapped As Boolean Dim dtTemp As Date Dim intCounter As Integer Dim lngDiffYears As Long Dim lngDiffMonths As Long Dim lngDiffDays As Long Dim varTemp As Variant Const INTERVALs2 As String = "ddmmyyyy" interval = LCase$(interval) For intCounter = 1 To Len(interval) If InStr(1, INTERVALs2, Mid$(interval, intCounter, 1)) = 0 Then Exit Function End If Next intCounter If Not (IsDate(Date1)) Then Exit Function If Not (IsDate(Date2)) Then Exit Function If Date1 > Date2 Then dtTemp = Date1 Date1 = Date2 Date2 = dtTemp booSwapped = True End If Diff2Dates = Null varTemp = "" booCalcYears = (InStr(1, interval, "yyyy") > 0) booCalcMonths = (InStr(1, interval, "mm") > 0) booCalcDays = (InStr(1, interval, "dd") > 0) If booCalcYears Then lngDiffYears = Int(DateDiff("yyyy", Date1, Date2)) - IIf(Format$(Date1, "mm") <= Format$(Date2, "mm"), 0, 1) Date1 = DateAdd("yyyy", lngDiffYears, Date1) End If If booCalcMonths Then lngDiffMonths = Int(DateDiff("m", Date1, Date2)) - IIf(Format$(Date1, "dd") <= Format$(Date2, "dd"), 0, 1) Date1 = DateAdd("m", lngDiffMonths, Date1) End If If booCalcDays Then lngDiffDays = Int(DateDiff("d", Date1, Date2)) - IIf(Format$(Date1, "hh") <= Format$(Date2, "hh"), 0, 1) Date1 = DateAdd("d", lngDiffDays, Date1) End If If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " سنه ", " سنه ") End If If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then If booCalcMonths Then varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _ lngDiffMonths & IIf(lngDiffMonths <> 1, " شهر ", " شهر ") End If End If If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then If booCalcDays Then varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _ lngDiffDays & IIf(lngDiffDays <> 1, " يوم", " يوم") End If End If If booSwapped Then varTemp = "-" & varTemp End If Diff2Dates = Trim$(varTemp) End_Diff2Dates: Exit Function Err_Diff2Dates: Resume End_Diff2Dates End Function وفي الاستعلام استخدم التالي AGE: diff2dates("ddmmyyyy";[Fdate];[Ldate];True) Fdate = التاريخ الاول = 15-07-1991 Ldate = التاريخ الثاني = 05-02-2021 تحياتي

IIF([الاجازة]="عارضة"; null; [اعتيادى]) تحياتي

للاسف لا يمكن التعديل او الاضافة في مثل هذا استعلام تحياتي

السبب لا يمكن التعديل او الاضافة في مثل هذا استعلام تحياتي

ما شاء الله عليك اخي ابوعبدالله سلمت يداك تحياتي

بالتوفيق اخي الكريم تحياتي

وعليكم السلام ورحمة الله وبركاته جرب اخي الكريم واخبرني بالنتيجة Database3.rar تحياتي

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Data3.rar تحياتي

بالتوفيق اخي الكريم تحياتي

وعليكم السلام ورحمة الله وبركاته جرب التعديل التالي If Confirmation = False Then Exit Sub If MsgBox("هل تريد حفظ الإدخال الحالي", vbYesNo, "حفظ السجل") = vbNo Then DoCmd.CancelEvent Me.Undo Me.TxtUser.SetFocus Else If Me.NewRecord Then If Me.TxtUser = DLookup("Username", "Users", "[Username]='" & Me.TxtUser & "'") Then MsgBox "هذا المستخدم موجود مسبقاً", vbInformation, "تنبيه" Me.TxtUser.SetFocus Exit Sub End If Else DoCmd.Save DoCmd.Close End If End If Database2.rar تحياتي

وعليكم السلام وحمة الله وبركاته تفضل اخي الكريم B: [التوصية] & " " & Format([التاريخ];"yyyy/mm/dd") & " " & [الملاحظة] مثال للتاريخ.rar تحياتي

تفضل اخي الكريم هذا هو الكود المطلوب If id1 = 1 Then If MsgBox(" åá ÊÑíÏ ÇÛáÇÞ ÇáäãæÐÌ ", vbYesNo, " ÊÃßíÏ ÇáÍÝÙ") = vbYes Then DoCmd.Close acForm, "form1" End If End If والخلاف اين يتم وضع الكود ( في اي حدث ) يمكن اضافته في حدث عند الاغلاق للننموذج Private Sub Form_Close() او في حدث قبل التحديث Private Sub Form_BeforeUpdate(Cancel As Integer) او في حدث عند الخروج من مربع النص Private Sub id1_Exit(Cancel As Integer) او في حدث عند التغيير لمربع النص Private Sub id1_Change() هذا الكود يصلح لهذه الاحداث وغيرها تحياتي

جرب الكود في حدث عند الاغلاق Private Sub Form_Close() DoCmd.SetWarnings False If id1 = 1 Then If MsgBox(" هل تريد حفظ التغييرات؟ ", vbYesNo, " تأكيد الحفظ") = vbNo Then Me.Undo Exit Sub DoCmd.Close acForm, "form1" End If End If DoCmd.SetWarnings True End Sub مثال اوفيسنا كود عند اغلاق النموذج.rar تحياتي

السلام عليكم تفضل اخي الكريم Private Sub Form_BeforeUpdate(Cancel As Integer) DoCmd.SetWarnings False If id1 = 1 Then If MsgBox(" هل تريد حفظ التغييرات؟ ", vbYesNo, " تأكيد الحفظ") = vbNo Then Me.Undo Exit Sub DoCmd.Close acForm, "form1" End If End If DoCmd.SetWarnings True End Sub ولكن الرسالة الآن لن تظهر لن الحقل Id1 غير منضم اربط النموذج والحقل بجدول وسترى النتيجة ان شاء الله مثال اوفيسنا كود عند اغلاق النموذج.rar تحياتي