كل الانشطه

الشكر مقدما لكما فجزاكما الله خيرا اعتمدتما على اسم الفترة .. ولكن معرف الفترة اثبت .. لأن الفترة قد يتم تعديلها مثلا من الفترة الصباحية الى كلمة الصباح فقط ... ما علينا لا مشكلة يمكن التعديل .. ولكني افكر بسطر واحد فقط !! يقوم بالمهمة .. هل يمكن سطر واحد استعلام 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

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

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

شكرا لحضرتك استاذنا الفاضل لو تتكرم توضح السبب كان ايه و كيفية تصحيحة لانى هشتغل على قاعدة بيانات فارغة من الداتا @kanory

تحديث واستكمال @منتصر الانسي هل الامور تمام ❤️🌹☕ 1- اضافة تنظيف الذاكرة المؤقته مع اعادة الربط الآلي للجداول 2- تعديل الاقلاع ☕ 3- Form_Name.RowSource اضافة عدد عرض السجلات عن طريق ( كود بسيط لتقيسم ) - عند التجرب اذا كان كامل من غير تقسيم سوف يكون بطىء في الاستجابه من 1 الى 300 الف سجل دفعه كاملة - عند التقسيم كل 100 الف سجل اسرع - عند تقسيم 10 الف سجل سريع ومناسب وانظر الى السرعه عند الوصول الى 300 الف وحتى عند الوصول الى المليون او الملايين من السجلات Link db ScrollBar ( 5 , 6 ) مع تحكم بالاداءة Size 4- اضافة عند نقر المزدوج للحقل تضاف الى حقل الفلترة + تصحيح فواصل السجلات ... تحميل المرفق https://www.mediafire.com/file/zggh0ntu04tkaxb/V_3_Speed_Read_db_Caption_Filter.rar/file

معذرة لتأخير بالمباركة لأني بكمل عمليات عينيا بمصر مبروك علينا وتمنياتي بالتوفيق دائما

العمل ممتاز أخي الكريم أبو عيد مشكلته فقط فيما أشرت إذا زاد الغياب عن 10 تلاميذ مجهود مشكور جعله الله في ميزان حسناتك

بارك الله فيكم نعم الحقل نصي تاريخ ام القرى كامل لذا ذهبت الى عد الحروف .. ولظهور بعض الأخطاء طرحت سؤالي هنا . وتحويل النص الى تاريخ فكرة جيدة . وكنت اتحاشاها لوجود تعارض بين الهجري والميلادي في يوم او يومين من كل سنة ولهذا اشرت الى CDate(varDateTime)

وبسبب هذه الجملة اعيد صياغة الكود فى الوحدة النمطية العامة ليكون بهذا الشكل لاضافة قاموس لدعم اللغات المتعددة واضافة الاختصارات او الخطاء الشائعة او الممكنة فى المستقبل Public Function GetTimePeriod(ByVal varDateTime As Variant) As String On Error GoTo ErrHandler Const STR_MORNING As String = "الصباح" Const STR_EVENING As String = "المساء" If IsMissing(varDateTime) Or IsNull(varDateTime) Then Exit Function If Len(Trim(Nz(varDateTime, ""))) = 0 Then Exit Function Dim strInput As String strInput = Trim(CStr(Nz(varDateTime, ""))) ' استبدال التعابير المحلية أو الأجنبية بـ AM/PM Dim dicReplacements As Object Set dicReplacements = CreateObject("Scripting.Dictionary") With dicReplacements ' العربية .Add "ص", "AM" .Add "ص.", "AM" .Add "صباح", "AM" .Add "صباحا", "AM" .Add "صباحًا", "AM" .Add "صـ", "AM" .Add "صـباح", "AM" .Add "صباحاً", "AM" .Add "م", "PM" .Add "م.", "PM" .Add "مساء", "PM" .Add "مساءً", "PM" .Add "مسائا", "PM" .Add "مساءاً", "PM" .Add "مسائياً", "PM" ' الفرنسية .Add "matin", "AM" .Add "du matin", "AM" .Add "soir", "PM" .Add "du soir", "PM" .Add "après-midi", "PM" ' الألمانية .Add "vormittag", "AM" ' قبل الظهر .Add "morgen", "AM" ' الصباح .Add "morgens", "AM" ' في الصباح .Add "nachmittag", "PM" ' بعد الظهر .Add "abend", "PM" ' المساء .Add "abends", "PM" ' في المساء .Add "nachts", "PM" ' ليلًا ' الإنجليزية - دعم إضافي لأنماط مكررة .Add "am", "AM" .Add "pm", "PM" .Add "a.m.", "AM" .Add "p.m.", "PM" .Add "a.m", "AM" .Add "p.m", "PM" .Add "A.M.", "AM" .Add "P.M.", "PM" .Add "A.M", "AM" .Add "P.M", "PM" End With Dim varKey As Variant For Each varKey In dicReplacements.Keys strInput = Replace(strInput, varKey, dicReplacements(varKey), , , vbTextCompare) Next varKey ' تنسيق الوقت (دمج من FixTimeFormat) Dim strSuffix As String Dim strTimeOnly As String Dim arrParts() As String If InStr(1, strInput, "AM", vbTextCompare) > 0 Then strSuffix = " AM" strTimeOnly = Replace(strInput, "AM", "", , , vbTextCompare) ElseIf InStr(1, strInput, "PM", vbTextCompare) > 0 Then strSuffix = " PM" strTimeOnly = Replace(strInput, "PM", "", , , vbTextCompare) Else strSuffix = "" strTimeOnly = strInput End If strTimeOnly = Trim(strTimeOnly) arrParts = Split(strTimeOnly, ":") If UBound(arrParts) >= 0 Then arrParts(0) = Format$(Val(arrParts(0)), "00") End If If UBound(arrParts) >= 1 Then arrParts(1) = Format$(Val(arrParts(1)), "00") Else ReDim Preserve arrParts(1) arrParts(1) = "00" End If strInput = Join(arrParts, ":") & strSuffix ' التحويل إلى وقت فعلي Dim dtmTime As Date dtmTime = CDate(strInput) Dim lngHour As Long lngHour = Hour(dtmTime) If lngHour < 12 Then GetTimePeriod = STR_MORNING Else GetTimePeriod = STR_EVENING End If Exit Function ErrHandler: GetTimePeriod = "" End Function

طبعا تم تغيير كبير في الملف وهذا لازم لتقليل حجم الملف ولتطبيق وتنفيذ مطلوبك تم حدف ورقة من الأوراق , ليس لها لزمة تم فك الدمج عن بعض الأسطر والاعمدة والأن قم بتغيير القيمة في الخلية الكحلية (الفصول 1 - 3) حيث أنها تحتوي على قائمة منسدلة واختر التاريخ المطلوب وانظر للنتيجة باقي حاجة أنا نسيت المعادلات في أسفل الورقة ممكت تكتبهم من جديد المشكلة الأن : لو كان عدد الغائبين في الفصل الواحد أكثر من 10 فهذا الحل سيأتي بالعشرة فقط الغياب2.xls

بالنسبة للدالة Hour بهذا الشكل IIf(Hour([chekin]) < 12, "الصباح", "المساء") هذا السطر لا يتأثر بالتنسيق الإقليمي للنظام طالما أن الحقل [chekin] يحتوي فعليا على قيمة من النوع Date/Time لماذا لا يتأثر؟ الدالة Hour(...) تعتمد على القيمة الداخلية للوقت المخزن في Access وليس على الشكل المعروض Access يخزن التاريخ/الوقت كقيمة رقمية مزدوجة (Double) الجزء الصحيح للتاريخ والجزء الكسري للوقت نظام العرض (12/24 ساعة – AM/PM) يخص شكل العرض فقط بينما الدالة Hour() دائما ترجع رقم بين 0 و23 بغض النظر عن التنسيق ولكن ماذا لو كان نوع البيانات للحقل نص وليس تاريخ لابد من الاستخدام بالشكل التالى IIf(IsDate([chekin]) And Hour(CDate([chekin])) < 12, "الصباح", "المساء")

تفضل ...... EL-DATA- T.rar

طيب ايه الفرق بين Public Function GetTimePeriod(ByVal varDateTime As Variant) As String Public Function GetPeriod(dt As Date) As String GetTimePeriod أكثر أمانا ومرونة لان الوسيط Variant بعكس الوسيط Date صارم التحقق من Null أو "" التحويل إلى تاريخ باستخدام CDate يدعم Null / نصوص صالحة للتحويل مناسب للاستخدام من النماذج / الحقول مباشرة

السلام عليكم استفسار من فضلكم بخصوص تكرار قيمة حقول فى استعلام تجميع مرفق صورة و مرفق الملف EL-DATA- T.rar

جزيت خيرا اخي ناقل .. السطر يتحدث عن نفسه .. سوف اجربه انا حريص على عدم وجود ثغرات .. خاصة وان التاريخ عرضة للتغير بسبب تنسيقات وندوز ... عربي /انجليزي /ونظام 12 و 24 لذا اعتقد ان كلمة السر في كود ابي جودي هي هذا السطر : dtmTime = CDate(varDateTime)