كل الانشطه

في المرفق :- وحتى لو كانت رقمية ، جربت النتيجة وبدون أخطاء او خلل فيها

بس يا فؤش عندك غلط ftraName IN (1, 2) ده المفروض لان الحقول رقمية مش نصية انت استخدمتها: ftraName IN ('1','2') والمفروض ده لو كانت الحقول نصية يا فؤش المفروض دى ارقام المعرف id

فيما لو كانت القيمة المخزنة في جدولك يمثل رقم الفترة من جدولها ( معرف الفترة افترضت انه 1 = الصباحية ، 2 = المسائية بغض النظر عن التسمية )

ولكن جميع القيم النصية لا تشتمل على هذه الارقام .... لم افهم

معنى ftraName IN ('1','2'): هذا الشرط يعني أن الاستعلام سيختار السجلات من جدول tbl_Ftrat التي يكون فيها حقل ftraName يساوي إما 1 أو 2 بمعنى آخر: سيتم تضمين أي سجل يكون فيه ftraName مساويا للقيمة 1 أو 2

شكرا على الاضافة الجميلة ماذا يعني الرقمين هنا ftraName IN ('1','2')

الكود الأول أفضل لأنه: يضمن كتابة قيمة منسقة بشكل صحيح لنوع Date/Time باستخدام Format(datResult, "hh:nn") ورمزي # يحدد السجلات بدقة (id=2 وid=3) وبذلك يتجنب أي سجلات غير مرغوبة أكثر وضوحا للوضع الحالي حيث الهدف هو جمع ساعتين محددتين فقط الكود الثاني أقل ملاءمة لأنه: يكتب قيمة رقمية (Double) مباشرة مما قد يؤدي إلى تخزين غير صحيح (مثل أيام بدلا من ساعات) في حقل Date/Time شرط ftraName IN ('1','2') AND ID > 1 قد يشمل سجلات غير مرغوبة إذا كانت هناك سجلات إضافية بـ ftraName='1' أو '2' وID > 3

لا تكتفى بما لديك كلف نفسك عناء محاولة ايجاد و معرفة الفرق بين Private Sub cmdSave_Click() Dim lngMinutesMorning As Long Dim lngMinutesEvening As Long Dim lngTotalMinutes As Long Dim datResult As Date '' === احسب عدد الدقائق للفترتين lngMinutesMorning = DateDiff("n", #00:00#, DLookup("countWorkHours", "tbl_Ftrat", "id=2")) lngMinutesEvening = DateDiff("n", #00:00#, DLookup("countWorkHours", "tbl_Ftrat", "id=3")) '' === إجمالي عدد الدقائق lngTotalMinutes = lngMinutesMorning + lngMinutesEvening '' === تحويله إلى نسبة يوم Date/Time datResult = lngTotalMinutes / 1440 '' === تحديث السجل للمعرف رقم 1 CurrentDb.Execute "UPDATE tbl_Ftrat SET countWorkHours = #" & Format(datResult, "hh:nn") & "# WHERE id = 1", dbFailOnError countWorkHours.Requery Me.Repaint End Sub وبين الحل الاخير لك Dim totalMinutes As Double totalMinutes = DSum("countWorkHours", "tbl_Ftrat", "ftraName IN ('1','2') AND ID > 1") CurrentDb.Execute "UPDATE tbl_Ftrat SET countWorkHours = " & totalMinutes & " WHERE ID = 1", dbFailOnError Me.Refresh

أنا سأكتفي بما لدي في آخر محاولة ,, في الزر :- Dim totalminutes As Double totalminutes = Nz(DSum("countWorkHours", "tbl_Ftrat", "ftraName IN ('1','2') AND ID > 1"), 0) CurrentDb.Execute "UPDATE tbl_Ftrat SET countWorkHours = " & totalminutes & " WHERE ID = 1", dbFailOnError Me.Refresh الملف المرفق :- Database2.zip

ماشى ممكن كده سطر واحد استعلام تحديث لتحقيق المطلوب وكمان الاعتماد الى المعرف Private Sub cmdSave_Click() Dim lngMinutesMorning As Long Dim lngMinutesEvening As Long Dim lngTotalMinutes As Long Dim datResult As Date '' === احسب عدد الدقائق للفترتين lngMinutesMorning = DateDiff("n", #00:00#, DLookup("countWorkHours", "tbl_Ftrat", "id=2")) lngMinutesEvening = DateDiff("n", #00:00#, DLookup("countWorkHours", "tbl_Ftrat", "id=3")) '' === إجمالي عدد الدقائق lngTotalMinutes = lngMinutesMorning + lngMinutesEvening '' === تحويله إلى نسبة يوم Date/Time datResult = lngTotalMinutes / 1440 '' === تحديث السجل للمعرف رقم 1 CurrentDb.Execute "UPDATE tbl_Ftrat SET countWorkHours = #" & Format(datResult, "hh:nn") & "# WHERE id = 1", dbFailOnError countWorkHours.Requery Me.Repaint End Sub وبالمرة ده تعديل بسيط للدالة داخل الوحدة النمطية '' ========================================================== '' الدالة: HoursAndMinutes '' الوصف: تحويل قيمة وقت مخزنة كنسبة من اليوم (Date/Time) إلى نص يحتوي على عدد الساعات والدقائق '' المعامل: interval - متغير يمثل مدة زمنية كنسبة من اليوم (مثلاً 0.5 = 12 ساعة) '' الناتج: نص بصيغة "ساعات:دقائق" '' ========================================================== Public Function HoursAndMinutes(interval As Variant) As String Dim lngTotalMinutes As Long Dim lngHours As Long Dim lngMinutes As Long If IsNull(interval) Then Exit Function lngTotalMinutes = Int(CSng(interval * 24 * 60)) ' تحويل إلى عدد الدقائق lngHours = lngTotalMinutes \ 60 ' الساعات الكاملة lngMinutes = lngTotalMinutes Mod 60 ' باقي الدقائق HoursAndMinutes = lngHours & ":" & Format(lngMinutes, "00") ' تنسيق بدقائق صفرية عند الحاجة End Function

طيب ، كفكرة أخرى بتحديد شروط الفلترة أكثر من خلال الاستدعاء ، جرب هذا التعديل :- Public Sub UpdateRecordSumAfterID_ByFilter(tableName As String, idField As String, idValue As Variant, targetField As String, sumField As String, Optional filterField As String = "", Optional filterValue1 As String = "", Optional filterValue2 As String = "") Dim rs As DAO.Recordset Dim total As Double Dim foundTarget As Boolean Set rs = CurrentDb.OpenRecordset(tableName, dbOpenDynaset) If rs.EOF Then Exit Sub rs.MoveFirst foundTarget = False Do Until rs.EOF If foundTarget Then If filterField <> "" Then If rs.Fields(filterField).Value = filterValue1 Or rs.Fields(filterField).Value = filterValue2 Then total = total + Nz(rs.Fields(sumField).Value, 0) End If Else total = total + Nz(rs.Fields(sumField).Value, 0) End If ElseIf rs.Fields(idField).Value = idValue Then foundTarget = True End If rs.MoveNext Loop rs.MoveFirst Do Until rs.EOF If rs.Fields(idField).Value = idValue Then rs.Edit rs.Fields(targetField).Value = total rs.Update Exit Do End If rs.MoveNext Loop rs.Close Set rs = Nothing DoCmd.RunCommand acCmdRefresh End Sub وسيكون الإستدعاء كالآتي :- Call UpdateRecordSumAfterID_ByFilter( _ "tbl_Ftrat", _ "ID", 1, _ "countWorkHours", _ "countWorkHours", _ "ftraName", _ "فترة صباحية", _ "فترة مسائية")

الشكر مقدما لكما فجزاكما الله خيرا اعتمدتما على اسم الفترة .. ولكن معرف الفترة اثبت .. لأن الفترة قد يتم تعديلها مثلا من الفترة الصباحية الى كلمة الصباح فقط ... ما علينا لا مشكلة يمكن التعديل .. ولكني افكر بسطر واحد فقط !! يقوم بالمهمة .. هل يمكن سطر واحد استعلام Update ان يحقق المطلوب ؟ افكر بصوت مكتوب فقط

انت يا عم الحاج فؤش افندى ماشى معايا بالعكس اكتب انا الاجابة من خلال كود فى وحده نمطية تقولى انت احب اكون مباشر والاجابة مباشرة اكتب انا الكود مباشر للحالات المباشرة تكتب انت الكود فى وحده نمطيه احنا هنلعب بئه واللا ايــــه

هل يفى ذلك بالغرض و يحقق المطلوب ؟ Private Sub cmdSave_Click() On Error GoTo ErrorHandler Dim rst As DAO.Recordset Dim datInterval As Date Dim dblTotalMinutes As Double Dim strFtraName As String Set rst = CurrentDb.OpenRecordset("tbl_Ftrat", dbOpenDynaset) dblTotalMinutes = 0 Do While Not rst.EOF strFtraName = Trim(Nz(rst!ftraName, "")) If strFtraName = "فترة صباحية" Or strFtraName = "فترة مسائية" Then If Not IsNull(rst!countWorkHours) Then ' تحويل الوقت إلى دقائق: القيمة * 24 * 60 dblTotalMinutes = dblTotalMinutes + (rst!countWorkHours * 24 * 60) If DebugMode Then Debug.Print "تمت إضافة عدد الدقائق: "; rst!countWorkHours End If End If rst.MoveNext Loop ' تحويل عدد الدقائق الإجمالية إلى قيمة Time لتخزينها في الحقل Date/Time datInterval = dblTotalMinutes / (24 * 60) rst.MoveFirst Do While Not rst.EOF strFtraName = Trim(Nz(rst!ftraName, "")) If strFtraName Like "*فترتين*" Then rst.Edit rst!countWorkHours = datInterval rst.Update Exit Do End If rst.MoveNext Loop countWorkHours.Requery Me.Repaint rst.Close Set rst = Nothing MsgBox " تم تحديث عدد ساعات الفترة المجمعة بنجاح.", vbInformation Exit Sub ErrorHandler: MsgBox " خطأ: " & Err.Description, vbCritical If Not rst Is Nothing Then rst.Close Set rst = Nothing End Sub

بغض النظر عن الخطأ الذي ذكره أبو جودي ، ومن المؤكد أن السجلات هي للتجربة فقط لا غير .. في الدالة العامة التالية :- Public Sub UpdateRecordWithID(frm As Form, idField As String, idValue As Variant, targetField As String, sumField As String) Dim rs As DAO.Recordset Dim total As Double Dim foundTarget As Boolean Set rs = frm.RecordsetClone rs.MoveFirst Do Until rs.EOF If foundTarget Then If rs!ftraName = "فترة صباحية" Or rs!ftraName = "فترة مسائية" Then total = total + Nz(rs.Fields(sumField).Value, 0) End If ElseIf rs.Fields(idField).Value = idValue Then foundTarget = True End If rs.MoveNext Loop If Not foundTarget Then rs.Close: Set rs = Nothing Exit Sub End If rs.MoveFirst Do Until rs.EOF If rs.Fields(idField).Value = idValue Then frm.Recordset.Bookmark = rs.Bookmark frm.Controls(targetField).Value = total frm.Dirty = False Exit Do End If rs.MoveNext Loop rs.Close: Set rs = Nothing End Sub تركت لك حرية تحديد اسم الحقل الفريد ورقمه ، واسم الحقل المستهدف تحديثه بالقيم التي تريدها من خلال الاستدعاء كالآتي :- Call UpdateRecordWithID(Me, "ID", 1, "countWorkHours", "countWorkHours") الملف مع الفكرة المقترحة :- Database1.zip

تمام حضرتك عاوز مجموع ساعات العمل للفترين الصباحية والمسائية فقط انا كده فهمت صح ولو انا فهمت صح فى خطأ فى حساب الفترة المسائية هى الان : 5:40 والمفروض الصح تكون : 6:10

وعليكم السلام ورحمة الله وبركاته ... هل المقصود كهذه النتيجة :-

يعنى المفروض يكون الفترين موجودين حضور وانصراف وعند الضغط على زر الحفظ يتم جمع ساعات العمل ؟

كما تشاهد في الصورة : الحقل الأول الأعلى فارغ .. الخاص بالفترتين ... لأن السجل مجرد مسمى ليس امامه وقت دخول ولا خروج اريد ان يتم ادراج قيمة في هذا الحقل هذه القيمة = مجموع ساعات العمل : المسائية + الصباحية بحيث تصبح القيمة= 09:40

انا مش فاهم معلش محتاج لتوضيح

السلام عليكم كما في الصورة والملف المرفقين اريد عند الضغط على زر الحفظ .. يتم ادراج مجموع ساعات العمل في الفترة الصباحية والفترة المسائية تدرج في الفترتين (صباحي/مسائي) Database1.rar

ايه الحلاوة دى الله عليك بجد فعلا الفكرة ولا اروع وعلشان عجبتنى الفكرة كتبت لها هذا الكود الذى يقوم بانشاء الجدول وملئ البيانات وانشاء الاستعلام بشكل آلى وديناميكى بدون ادنى جهد وطبعا لم انسى الاخذ فى الحسبان اضفاء المرونة التامة بالتحكم فى كل كبيرة صغيرة الكود Option Compare Database Option Explicit '' === ثوابت عامة لإعدادات توليد التواريخ === Public Const TABLE_NAME As String = "tblCalendarComponents" Private Const QUERY_NAME As String = "qryGenerateFullDates" Public Const DATE_TYPE_DAY As String = "DayType" Public Const DATE_TYPE_MONTH As String = "MonthType" Public Const DATE_TYPE_YEAR As String = "YearType" Public Const DefaultYearOffset As Long = 3 Public Const DefaultStartYear As Long = 0 Public Const DefaultYearCount As Long = 100 Public Const MIN_YEAR As Long = 1900 Public Const MAX_YEAR As Long = 2100 '' === TestGenerateDates Public Sub TestGenerateDates() ''--- سنة البدء (0 = القيمة الافتراضية) Dim lngStartYear As Long: lngStartYear = 0 ''--- فرق السنوات الافتراضي Dim lngOffset As Long: lngOffset = DefaultYearOffset ''--- عدد السنوات المراد توليدها Dim lngYearCount As Long: lngYearCount = 10 Call GenerateDates(lngStartYear, lngOffset, lngYearCount) End Sub '' ======= الإجراء الرئيسي لإنشاء الجدول والاستعلام ======= Public Sub GenerateDates( _ Optional ByVal StartYear As Long = 0, _ Optional ByVal YearOffset As Long = DefaultYearOffset, _ Optional ByVal YearCount As Long = DefaultYearCount) On Error GoTo ErrorHandler ' تعيين الفرق الافتراضي إن لم يُمرر If YearOffset = -1 Then YearOffset = DefaultYearOffset ' حساب سنة البدء إذا لم تُمرر If StartYear = 0 Then StartYear = Year(Date) - YearOffset ' التحقق من سنة البدء ضمن النطاق If StartYear < MIN_YEAR Or StartYear > MAX_YEAR Then Err.Raise vbObjectError + 1000, , "StartYear يجب أن يكون بين " & MIN_YEAR & " و " & MAX_YEAR End If ' التحقق من عدد السنوات ضمن النطاق If YearCount < 1 Or YearCount > (MAX_YEAR - StartYear + 1) Then Err.Raise vbObjectError + 1001, , "YearCount يجب أن يكون بين 1 و " & (MAX_YEAR - StartYear + 1) End If ' إنشاء الجدول والاستعلام Call PopulateDateTable(StartYear, YearCount) Call CreateOrUpdateDateGenerationQuery MsgBox "تم إنشاء الجدول والاستعلام بنجاح.", vbInformation, "نجاح العملية" Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء إنشاء الجدول أو الاستعلام:" & vbCrLf & _ "رقم الخطأ: " & Err.Number & vbCrLf & _ "الوصف: " & Err.Description, vbCritical, "خطأ" End Sub '' ======= ملء جدول التواريخ ======= Public Sub PopulateDateTable( _ Optional ByVal StartYear As Long = DefaultStartYear, _ Optional ByVal YearCount As Long = DefaultYearCount) On Error GoTo ErrorHandler Dim db As DAO.Database: Set db = CurrentDb ' حذف الجدول قبل الإنشاء On Error Resume Next db.TableDefs.Delete TABLE_NAME On Error GoTo ErrorHandler Call CreateDateTable(db) If StartYear = 0 Then StartYear = Year(Date) - DefaultYearOffset Dim i As Long For i = 1 To 31 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & i & ", '" & DATE_TYPE_DAY & "')", dbFailOnError Next i For i = 1 To 12 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & i & ", '" & DATE_TYPE_MONTH & "')", dbFailOnError Next i For i = 0 To YearCount - 1 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & StartYear + i & ", '" & DATE_TYPE_YEAR & "')", dbFailOnError Next i Set db = Nothing Exit Sub ErrorHandler: MsgBox " خطأ أثناء تعبئة الجدول: " & Err.Description, vbCritical End Sub '' ==== دالة لحساب الحد الأقصى لطول النص بين أنواع التاريخ Public Function GetMaxDateTypeLength() As Long Dim lngMaxLen As Long lngMaxLen = Len(DATE_TYPE_DAY) If Len(DATE_TYPE_MONTH) > lngMaxLen Then lngMaxLen = Len(DATE_TYPE_MONTH) If Len(DATE_TYPE_YEAR) > lngMaxLen Then lngMaxLen = Len(DATE_TYPE_YEAR) GetMaxDateTypeLength = lngMaxLen End Function '' ======= إنشاء الجدول مع الحقول والفهرسة ======= Private Sub CreateDateTable(db As DAO.Database) On Error Resume Next db.TableDefs.Delete TABLE_NAME On Error GoTo 0 Dim tdf As DAO.TableDef Set tdf = db.CreateTableDef(TABLE_NAME) With tdf '' حقل الترقيم التلقائي Dim fld As DAO.Field Set fld = .CreateField("ID", dbLong) fld.Attributes = dbAutoIncrField .Fields.Append fld '' حقل الرقم Set fld = .CreateField("DateNo", dbLong) fld.Required = True .Fields.Append fld '' نوع التاريخ Set fld = .CreateField("DateType", dbText, GetMaxDateTypeLength()) fld.Required = True .Fields.Append fld End With '' فهرس المفتاح الأساسي Dim idx As DAO.Index Set idx = tdf.CreateIndex("PrimaryKey") idx.Primary = True idx.Fields.Append idx.CreateField("ID") tdf.Indexes.Append idx '' فهرس فريد على التاريخ والنوع Set idx = tdf.CreateIndex("UniqueDateNoType") idx.Unique = True idx.Fields.Append idx.CreateField("DateNo") idx.Fields.Append idx.CreateField("DateType") tdf.Indexes.Append idx db.TableDefs.Append tdf Set fld = Nothing Set idx = Nothing Set tdf = Nothing End Sub '' ======= إنشاء أو تحديث الاستعلام لإنتاج كل التواريخ ======= Public Sub CreateOrUpdateDateGenerationQuery() On Error GoTo ErrorHandler Dim db As DAO.Database: Set db = CurrentDb Dim strSQL As String Dim qdf As DAO.QueryDef strSQL = "SELECT DateSerial(Years.DateNo, Months.DateNo, Days.DateNo) AS GeneratedDate " & _ "FROM " & TABLE_NAME & " AS Days, " & _ TABLE_NAME & " AS Months, " & _ TABLE_NAME & " AS Years " & _ "WHERE Days.DateType = '" & DATE_TYPE_DAY & "' " & _ "AND Months.DateType = '" & DATE_TYPE_MONTH & "' " & _ "AND Years.DateType = '" & DATE_TYPE_YEAR & "'" '' حذف الاستعلام لو موجود If QueryExists(QUERY_NAME) Then db.QueryDefs.Delete QUERY_NAME End If '' إنشاء الاستعلام Set qdf = db.CreateQueryDef(QUERY_NAME, strSQL) Application.RefreshDatabaseWindow Exit Sub ErrorHandler: MsgBox " خطأ أثناء إنشاء الاستعلام: " & Err.Description, vbCritical End Sub '' ======= التحقق من وجود جدول ======= Private Function TableExists(ByVal TableName As String) As Boolean On Error Resume Next TableExists = (Len(CurrentDb.TableDefs(TableName).Name) > 0) On Error GoTo 0 End Function '' ======= التحقق من وجود استعلام ======= Private Function QueryExists(ByVal QueryName As String) As Boolean On Error Resume Next QueryExists = (Len(CurrentDb.QueryDefs(QueryName).Name) > 0) On Error GoTo 0 End Function واخيرا يتم تعديل الاعدادت المناسبة لك و فقط يتم عمل كل شئ من تشغيل الإجراء التالى: TestGenerateDates

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

الف لا بأس عليك أستاذنا خليفة . ونسأل الله لك الشفاء العاجل القريب . إن ربك لهو المُجيب .. الله يبارك فيك 💐