Hawiii

مع أني لي دارية بدوال التاريخ للنظام ولكنها لم تخطر على بالي ، استخدامك للدالة DateDiff مكافئ للدالة التي نصحت بها ولكن أدخلت عليها نفس التعديل للدالة الأولى لتصبح كالتلي: Function WeekDiff(ByVal Date1 As Date, _ ByVal Date2 As Date, _ WkDay As VbDayOfWeek) As Long If Date1 <= Date2 Then Date1 = Date1 - 1 Else Date2 = Date2 - 1 End If WeekDiff = Abs(DateDiff("ww", Date1, Date2, WkDay)) End Function

ارفع لي ملفك مرة أخرى بإصدار 2007 أو أقل.

سبحان الله ، هذا المنتدى يحتاج إلى محكمين من خارجه حتى لا يضيع الطلبة والمبتدئون. هذا مثال للدالة التي نصحت بها ودالة الدكتور ، أرجو لصقه ثم تشغيل الإجاراءين لمعرفة الفرق بين النتائج ووقت التنفيذ. كود في قمة الإتقان لم أرى شبيها له قبله ولن يأتي بعده ، واللي يحب يعترض يقابلني سنة 2500 ميلادي. Function CountWkDay(ByVal Date1 As Long, _ ByVal Date2 As Long, _ WkDay As Byte) As Variant If Date1 <= Date2 Then Date1 = Date1 - 1 Else Date2 = Date2 - 1 End If Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Abs(Date2 - Date1) End Function Function WkDayCount(VarDate As Date, enddate As Date) As Long 'دالة د. كاف يار Dim SFriday As Long Do While VarDate < enddate VarDate = DateAdd("D", 1, VarDate) If Weekday(VarDate, 2) = vbFriday Then SFriday = SFriday + 1 End If Loop WkDayCount = SFriday End Function Sub Test1() Dim Date1 As Date Dim Date2 As Date Date1 = DateSerial(2021, 7, 23) Date2 = DateSerial(2021, 7, 30) Debug.Print CountWkDay(Date1, Date2, vbFriday) Debug.Print WkDayCount(Date1, Date2) End Sub Sub Test2() Dim Date1 As Date Dim Date2 As Date Dim Start As Single Date1 = DateSerial(2021, 7, 23) Date2 = DateSerial(9000, 7, 25) Start = Timer Debug.Print CountWkDay(Date1, Date2, vbFriday), Timer - Start Start = Timer Debug.Print WkDayCount(Date1, Date2), Timer - Start End Sub

لصق الدالة من الموضوع الأصلي: Function CountWkDay(ByVal Date1 As Long, _ ByVal Date2 As Long, _ WkDay As Byte) As Variant If Date1 <= Date2 Then Date1 = Date1 - 1 Else Date2 = Date2 - 1 End If Date1 = Fix((Date1 + (7 - WkDay)) / 7) Date2 = Fix((Date2 + (7 - WkDay)) / 7) CountWkDay = Abs(Date2 - Date1) End Function

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

جمع أيام الحمعة والسبت بين تاريخين

لا أنصح باستخدام Last فهي لا تعني الأكبر حيث Last تعني آخر إدخال هنا يجب أن تضمن أن الإدخالات أدخلت بالترتيب الزمني 100%. عموما عملت لك حل آخر ولا يهون الأساتذة الذين سبقوني بالحل ، وهو تصميم استعلامين بدلا من استعلام واحد فهو أكثر ضمانا لصحة البيانات المطلوبة. كما صممت لك استعلام ثالث يظهر لك الإختلافات بين الأكبر والأخير وقد أظهر اختلافات لـ 105 طالب. الإستعلامات التي صممتها تبدأ بـ qry. test_Hawiii.rar

لا داعي لاستخدامها بعد هذه التجربة واختبارها من الأستاد @kha9009lid ، ولكن ما المشكلة لو استخدمتها؟ ، فيه مثل محلي بس لا أريد أذكره هنا فقد يساء فهمه لمن ليس من بيئتي ، ولكن معناه أن في بعض الأمور نأتي بها ليست ذات عبئ فإن أتينا بها فنتيجتها : إن ما نفعت فهي لا تضر 🙂 ، توكل على الله ولا تحير نفسك ، وأنصحك إما تستخدمها أو لا تستخدمها 🙂

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

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

بعد الإعتذار لكل من ساهم في الحلول فلم أطلع عليها. في مايكروسوفت أكسس Form تسميه نموذج Report تسميه تقرير فأنت تريد تقريرا وليس نموذجا. رفعت لك التقرير حسب المطلوب ومصدره استعلام. فقط مثالي لتعرف كيفية تصميم الحقل فانظر لخائصه وانظر لمصدر الحقل في الاستعلام. خذ الفكرة وطبقها على تقاريرك حسب الرغبة. الرصيد التراكمي.rar

ربما ينفعك هذا الموضوع: نموذج التقويم ( النتيجة )

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

لو تزودوني بنسخة 2007 حتى أقدر أشارككم بفكرة ثالثة تختمر في رأسي.

في نفس المكان أخي ، خاصية القيمة الإفتراضية Default Value موفقين

أعتقد أن صاحب هذا الموضوع أول من كتب كود الشجرة في مواقع الأكسس العربية على الإطلاق. ليت كل من ينقل عنهم ولو جزئيا ذكر المصدر وإن كان يجهله فليذكر اسم المنتدى وإن لم يتذكره فليوضح أقلها أن (الأصل) ليس من جهده. مثال لعرض الشجرة - قسم الأكسيس Access - أوفيسنا (officena.net) تقبل الله صيامكم وقيامكم

ويمكنك أيضا استخدام دالة التاريخ: = DateSerial(2020,1,1) وهي (عندي) أفضل من كتابتها بين علامتي الرقم وخصوصا لتجنب الخلط بين اليوم والشهر. كذلك تحتاج أن تجعل نوع الحقل تاريخ فربما النوع عندك نص.

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

المثال نفسه جمعت فيه ثلاث الطرق السابقة وأضفت عليه رابعة بعد الإستفادة من الطريقة الثالثة طريقة الأستاذ خالد يعني المثال فيه أربع طرق الآن Private Sub Product_NO_AfterUpdate() 'Hawiii Dim rst As DAO.Recordset Dim flds As Variant Dim fldsArray Dim fld As Field Dim count As Integer On Error Resume Next '------------------------------------- Const tableName As String = "Products" Const fldsKey As String = "Product_NO" '------------------------------------- Set rst = CurrentDb.OpenRecordset(tableName, dbOpenSnapshot) With rst For Each fld In .Fields If fld.Name <> fldsKey Then count = count + 1 flds = flds & IIf(count > 1, "] & '|' & [", "[") & fld.Name 'If count = 10 Then Exit For End If Next fld flds = flds & "]" '-------------------------- flds = DLookup(flds, tableName, fldsKey & "=" & Me(fldsKey)) If IsNull(flds) Then GoTo fldsClear fldsArray = Split(flds, "|") '-------------------------- count = -1 For Each fld In .Fields If fld.Name <> fldsKey Then count = count + 1 Me(fld.Name) = fldsArray(count) Me(fld.Name).Picture = "" Me(fld.Name).Picture = CurrentProject.Path & "\Images\" & fldsArray(count) 'If count = UBound(fldsArray) Then Exit For End If Next fld End With rst.Close Exit Sub '-------------------------- fldsClear: For Each fld In rst.Fields If fld.Name <> fldsKey Then Me(fld.Name) = Null Me(fld.Name).Picture = "" End If Next fld rst.Close MsgBox "منتج غير مسجل", vbCritical + vbMsgBoxRight, "تنبيه" End Sub استدعاء بيانات المنتج_3.rar

شكرا لك أخ خالد ، أكيد شرحك مو لي 😃 ملخص الفكرة للمبتدئين : هو تجميع لعدة قيم حقول في متغير نصي واحد وهو هنا باسم (A) عن طريق البحث بدالة DLookup ثم نجري عملية عكسية بتفكيك قيمة المتغير النصي إلى عدة قيم وتخزينها في مصفوفة وهي هنا باسم (x) عن طريق دالة Split

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

ولاني نسيت أزيل .Fields حيث لا داعي لها هنا ، هنا أرفق لكم التعديل: Private Sub Product_NO_AfterUpdate() Dim rst As DAO.Recordset On Error Resume Next Set rst = CurrentDb.OpenRecordset("Products", dbOpenSnapshot) With rst .FindFirst "Product_NO=" & Me.Product_NO If Not .NoMatch Then Me.Product_Name = !Product_Name Me.Product_price = !Product_price Me.Product_Image.Picture = "" Me.Product_Image.Picture = CurrentProject.Path & "\Images\" & !Product_Image Else Me.Product_Name = Null Me.Product_price = Null Me.Product_Image.Picture = "" MsgBox "منتج غير مسجل", vbCritical + vbMsgBoxRight, "تنبيه" End If End With rst.Close 'Set rst = Nothing End Sub

شكرا للدكتور على المثال وزيادة في الإثراء ، هذه طريقتي في الوصول للبيانات Private Sub Product_NO_AfterUpdate() Dim rst As DAO.Recordset On Error Resume Next Set rst = CurrentDb.OpenRecordset("Products", dbOpenSnapshot) With rst .FindFirst "Product_NO=" & Me.Product_NO If Not .NoMatch Then Me.Product_Name = .Fields("Product_Name") Me.Product_price = .Fields("Product_price") Me.Product_Image.Picture = "" Me.Product_Image.Picture = CurrentProject.Path & "\Images\" & .Fields("Product_Image") Else Me.Product_Name = Null Me.Product_price = Null Me.Product_Image.Picture = "" MsgBox "منتج غير مسجل", vbCritical + vbMsgBoxRight, "تنبيه" End If End With rst.Close 'Set rst = Nothing End Sub

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

الحل في الإستعلام PreviousDate.rar