نجوم المشاركات

وعليكم السلام-اجعل المعادلة هكذا =IF($M$1="زيت 20لتر",(SUMIFS($F$1:$F$5,$B$1:$B$5,$M$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))+SUMIFS($F$1:$F$5,$B$1:$B$5,$N$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0)))/(20*SUMIFS($D$1:$D$5,$B$1:$B$5,$M$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))+IF($N$1="زيت 5لتر",$K$1*SUMIFS($D$1:$D$5,$B$1:$B$5,$N$1,$G$1:$G$5,$L$1,$A$1:$A$5,">="&L4,$A$1:$A$5,"<="&EOMONTH(L4,0))))) ورقة عمل1 Microsoft Excel جديد.xlsx

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد وذلك حتى نتأكد من عدم حدوث تكرار وطبعا كالعادة سوف اقدم لكم اليوم فكرتى المتواضعة فى هذا الشأن من خلال استخدام وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع '|-----------------------------------------------------------| '|---15/09/1443-------16/04/2022_____________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| 15/09/1443 | '| 16/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '|-----------------------------------------------------------| '======Check Input Exist By Input Type======================================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Public Function CheckInputExist( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ ByVal strObjectContainFieldValue) As Boolean On Error GoTo ErrorHandler Dim strFormName As Access.Form Dim stLinkCriteria As String Dim strMsgTitel As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strErrMsgTitel As String Dim strErrMsg As String Set strFormName = Screen.ActiveForm strMsgPrt1 = ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1593") & ChrW("1579") & ChrW("1608") & ChrW("1585") & ChrW("32") & ChrW("1593") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("40") & ChrW("160") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") & ChrW("1578") & ChrW("1602") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function Select Case FieldTypeName(strFieldName, strTableName) Case Is = "Text": stLinkCriteria = strFieldName & "= '" & strObjectContainFieldValue & "'" Case Is = "Date/Time": stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "dd/mm/yyyy") & "#" Case Is = "Long Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Byte": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Single": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Double": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue Case Is = "Decimal": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue End Select If DCount("*", strTableName, stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & strObjectContainFieldValue & strMsgPrt2, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" strFormName.Undo strFormName.Recordset.FindFirst stLinkCriteria Else End If procDone: Exit Function ErrorHandler: strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") strErrMsg = ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1581") & ChrW("1575") & ChrW("1608") & ChrW("1604") & ChrW("1578") & ChrW("32") & ChrW("1573") & _ ChrW("1583") & ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1576") & ChrW("1610") & _ ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & _ ChrW("1610") & ChrW("1581") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & _ ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1575") & _ ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") & ChrW("32") & ChrW("1607") & ChrW("1608") & ChrW("32") & _ ChrW("40") & ChrW("32") & FieldTypeName(strFieldName, strTableName) & ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1605") & ChrW("1606") & ChrW("32") & _ ChrW("1601") & ChrW("1590") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1573") & ChrW("1583") & _ ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & _ ChrW("1578") & ChrW("1578") & ChrW("1591") & ChrW("1575") & ChrW("1576") & ChrW("1602") & ChrW("32") & ChrW("1605") & ChrW("1593") & ChrW("32") & ChrW("1606") & _ ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") _ & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") Select Case Err.Number Case Is = 2471: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Is = 3075: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel Case Else MsgBox$ Err.Number & ": " & Err.Description End Select Resume procDone End Function Public Function FieldTypeName(ByRef strFieldName As String, ByRef strTableName As String) As String Dim db As DAO.Database Dim objRecordset As DAO.Recordset Dim i As Integer Set objRecordset = CurrentDb.OpenRecordset(strTableName) For i = 0 To objRecordset.Fields.Count - 1 If strFieldName = objRecordset.Fields(i).Name Then Dim strReturn As String Select Case CLng(objRecordset.Fields.Item(i).Type) 'fld.Type is Integer, but constants are Long. Case dbBoolean: strReturn = "Yes/No" ' 1 Case dbByte: strReturn = "Byte" ' 2 Case dbInteger: strReturn = "Integer" ' 3 Case dbLong ' 4 If (objRecordset.Fields.Item(i).Attributes And dbAutoIncrField) = 0& Then strReturn = "Long Integer" Else strReturn = "AutoNumber" End If Case dbCurrency: strReturn = "Currency" ' 5 Case dbSingle: strReturn = "Single" ' 6 Case dbDouble: strReturn = "Double" ' 7 Case dbDate: strReturn = "Date/Time" ' 8 Case dbBinary: strReturn = "Binary" ' 9 (no interface) Case dbText '10 If (objRecordset.Fields.Item(i).Attributes And dbFixedField) = 0& Then strReturn = "Text" Else strReturn = "Text (fixed width)" '(no interface) End If Case dbLongBinary: strReturn = "OLE Object" '11 Case dbMemo '12 If (objRecordset.Fields.Item(i).Attributes And dbHyperlinkField) = 0& Then strReturn = "Memo" Else strReturn = "Hyperlink" End If Case dbGUID: strReturn = "GUID" '15 'Attached tables only: cannot create these in JET. Case dbBigInt: strReturn = "Big Integer" '16 Case dbVarBinary: strReturn = "VarBinary" '17 Case dbChar: strReturn = "Char" '18 Case dbNumeric: strReturn = "Numeric" '19 Case dbDecimal: strReturn = "Decimal" '20 Case dbFloat: strReturn = "Float" '21 Case dbTime: strReturn = "Time" '22 Case dbTimeStamp: strReturn = "Time Stamp" '23 'Constants for complex types don't work prior to Access 2007 and later. Case 101&: strReturn = "Attachment" 'dbAttachment Case 102&: strReturn = "Complex Byte" 'dbComplexByte Case 103&: strReturn = "Complex Integer" 'dbComplexInteger Case 104&: strReturn = "Complex Long" 'dbComplexLong Case 105&: strReturn = "Complex Single" 'dbComplexSingle Case 106&: strReturn = "Complex Double" 'dbComplexDouble Case 107&: strReturn = "Complex GUID" 'dbComplexGUID Case 108&: strReturn = "Complex Decimal" 'dbComplexDecimal Case 109&: strReturn = "Complex Text" 'dbComplexText Case Else: strReturn = "unknown" End Select End If Next i FieldTypeName = strReturn End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى Call CheckInputExist("FieldName", "TableName", Me.txtBox) وأخيرا المرفق للتجربة ملاحظة : تم تعديل المرفق والكود بناء على رد استاذى الجليل الباش مهندس @Moosak التعديل النهائى بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ , 23 -أبريل -2022 م تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول Check Input Exist.accdb

في نموذج التواريخ مثل ما تلاحظ قمت بنسخ نفس القيمة المسجلة مسبقا ثم ضغطت على Check ولكن لم يعطيني رسالة تأكيد وجود التاريخ مسبقا 🙂

طيب ممكن نضيف السطر الاتى للكود وتم التعديل فى المرفق الرئيسي If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function لكن لم افهم

بعد بسم الله الرحمن الرحيم 😎 جزيل الشكر والإمتنان لك مهندسنا الغالي @ابو جودي بس عندي ليك كم ملاحظة 😏 أول ملاحظة ( لما يكون الحقل فاضي ) وهذا ينطبق على كل أنواع البيانات : الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) : والباقي زي العسل على الطحينة 😉

بارك الله فيكم وفي علمكم وجعله في ميزان حسناتكم على ما تعلمون الناس الخير

فضل هذه المحاولة في حدث عند الفتح ضح الكود التالي [id_n].DefaultValue = Year(Now()) & DCount("*", "T_takrir") + 1 [id_n].Format = "0000 - 0" مرفق التعديل جورج الطويل.accdb

كل الاحترام استاذ محمد بالعكس اضافاتك مميزة وتضفي اثراء للمشاركات كل عام وانتم بخير

السلام عليكم ورحمة الله وبركاته إخوتي الكرام: تم التحكم بحجم البيانات من خلال طريقة العمل التالية: ثم وضع ذلك في الكود Sub طباعة() ActiveWindow.SelectedSheets.PrintOut copies:=2 End Sub __________________________________________________________________________________________________________________________________ أعتذر للأستاذ الكريم نزار سليمان عيد لم أشاهد مشاركته إلا بعد أن شاركت بها وعلى كل هذا رافد ...والتنوع طيب ... بارك الله بكم تقبلوا مروري والسلام عليكم طبع الصفحات التي تحتوي على بيانات.xlsx123 (1).xlsm

Why five lines while it can be done in one line Me.TextBox1.Value = Cells(ActiveCell.Row, 1).Value

1 Dim stLinkCriteria As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strMsgPrt3 As String strMsgPrt1 = ChrW("1578") & ChrW("1581") & ChrW("1584") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1582") & ChrW("1589") & ChrW("1609") & ChrW("32") & ChrW("40") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("32") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1575") & ChrW("1605") & ChrW("1607") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1602") & ChrW("1576") & ChrW("1604") strMsgPrt3 = ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1606") & ChrW("1602") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1606") & ChrW("32") & ChrW("1573") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("46") stLinkCriteria = "[idnumber ]=" & Me.idnumber If DCount("*", "tblName", stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & Me.idnumber & strMsgPrt2 & vbCr & vbCr & strMsgPrt3, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" Me.Undo Me.Recordset.FindFirst stLinkCriteria Else End If فقط غير tblName الى اسم الجدول تبعك

السلام عليكم ورحمة الله يوضع هذا الكود فى حدث الفورم Private Sub CommandButton1_Click() Dim C As Range x = ActiveCell.Row Set C = Cells(x, 1) y = C.Value Me.TextBox1.Value = y End Sub

بالإشارة إلى تعدد الإستفسارات حول تطبيق لاستخدام المنتدى على الهاتف المحمول يرجى الاحاطة بان التطبيق المتوفر هو من نوع PWA Progressive Web App (PWA) اذا تصفحت الموقع باستخدام آخر اصدارات الكروم ، www.officena.net ستجد تنبيه منبثق بعنوان اضافة officena الي الشاشة الرئيسية: و بالضغط عليه سيتم تحميل التطبيق و في حال لم يظهر الاشعار السابق يمكن الضعط على الثلاث نقاط اعلي صفحة المنتدى من الهاتف و اختيار تثبيت التطبيق او بالانجليزية Add to Home Screen و سيتم اضافة ايقونة للتطبيق

استاذى الحبيبابو جودي بارك الله فيك اخى ظهر لى الخطأ التالى بارك الله فيك اخى الكريم وكل عام وحضرتك بكل خير

طب 2 / 10 على الأقل عشان أول واحد مجاوب والعيش والملح 😅 خلاص أنا هجاوبك في موضوعك الأصلي عشان عندي كم ملاحظة 😏

بارك الله فيك اخي الكريم وجزاك الله عنا خيرا طيب فى حالة وجود تكرار فلابد من وجود رسالة أن المدخل مكرر شاكرين فضلك وكرمك اخى احترامى

شكراً ابوجودي جعله الله في ميزان حسناتك

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

السلام عليكم ورحمة الله .. .ربما تقصد ما في هذه التجربة المتواضعة 112.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته جزاكم الله تعالى خيرًا أخي المُبارك أ. @محمد حسن المحمد ، وباركَ فيكم لطيبِ تعقيبكم. وصلى الله تعالى وسلّم على نبيّنا مُحمّد.

أشكر أخويّ الكريمين على هذه الكلمات الدافئة بارك الله بكما وجعل ذلك بموازين حسناتكما. فمن لم يشكر الناس لم يشكر الله. والسلام عليكم

وهذا تطبيق على برنامجك 🙂 حبيت أجرب كود الباش مهندس 😄🖐🏼️ جورج الطويل.accdb

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً وأحسن إليكم آمين الحقيقة: إن هذه الحياة الدنيا ظل زائل ، ولا يبقى إلا الذكرى الطيبة بين الناس ...ولذلك فإن الله تعالى لا يريد لنا العنت ولا يريد بنا العسر بل يريد بنا اليسر ... ومن خلال سيرة النبي محمد صلى الله عليه وآله وسلّم كان يحب التفاؤل حتى في تسمية الأولاد علماً أن الحياة ستمر بكل سهامها ... ولم لا ؟! .... وها نحن نقضي سنوات من أعمارنا نتوق إلى لحظة يلتئم شملنا بأهلنا الذين لا زالوا على قيد الحياة بعد أن طحنتنا هذه الحرب الضروس وعلى الرغم من كل ذلك لن نيأس من روح الله تعالى .... ستزول هذه الغمة بإذن الله تعالى وسيكون هذا الشريط القاتم من الذكريات المؤلمة... سينبلج فجر جديد بعد طول هذا الليل الذي نقاسيه. تقبلوا مروري والسلام عليكم

تحتاج لهذا الكود Sub PrintA() 'prints rows of data, will not print rows if column A is blank Application.ScreenUpdating = False Range("A:A").EntireRow.Hidden = False Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True ActiveWindow.SelectedSheets.PrintOut Copies:=1 Range("A:A").EntireRow.Hidden = False Application.ScreenUpdating = True End Sub او هذا الكود Sub PrintSummary() Dim myrange As String myrange = Cells(Rows.Count, 17).End(xlUp).Address ActiveSheet.PageSetup.PrintArea = "$A$1:" & myrange Application.Goto Reference:="R1C1" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=False End Sub فضلا انظر للمرفق طبع الصفحات التي تحتوي على بيانات.xlsx123 (1).xlsm

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

وعليكم السلام ورحمه الله وبركاته الله اكرم اطلع ع هذا الموضوع وجزاه الله خيرا ابوجودى وحاول تعدل لوحدك حتى تستفيد بالتوفيق

وعليكم السلام ورحمه الله وبركاته موجود معاينه قبل النشر اضغط ع الزر المعلم بالاحمر بالصوره بالتوفيق

شكرا ياباش مهندس @ابو جودي 🙂 ياريت لو تكمل معروفك وتعمل لنا شرح مبسط عن كيفية الاستخدام ( بالصور ) 😁

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

جميل استاذ موسى @Moosak ولكن ع ما يبدوا انك لم تنتبه الى باقى السؤال من اخى ابوجودى اعانك الله ع الكود وفى انتظار ابداعتكم وفقكم الله وان شاء الله فى ميزان حسناتكم بالتوفيق اخوانى

أهلا بالتحديات الجميلة 😉 يعني هذي محاولة بدون تجربة إن شاء الله تكون مضبوطة 😅 عملتها كدالة عامة ترجع لك نتيجة من نوع True or False Public Function CheckIDExist(IDField As String, TableName As String, FormName As form) As Boolean Dim stLinkCriteria As String Dim strMsgPrt1 As String Dim strMsgPrt2 As String Dim strMsgPrt3 As String strMsgPrt1 = ChrW("1578") & ChrW("1581") & ChrW("1584") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1585") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1588") & ChrW("1582") & ChrW("1589") & ChrW("1609") & ChrW("32") & ChrW("40") strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("32") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1575") & ChrW("1605") & ChrW("1607") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1602") & ChrW("1576") & ChrW("1604") strMsgPrt3 = ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1606") & ChrW("1602") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1570") & ChrW("1606") & ChrW("32") & ChrW("1573") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("46") stLinkCriteria = IDField & "=" & IDField If DCount("*", TableName, stLinkCriteria) > 0 Then MsgBox$ strMsgPrt1 & IDField & strMsgPrt2 & vbCr & vbCr & strMsgPrt3, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, "" FormName.Undo FormName.Recordset.FindFirst stLinkCriteria CheckIDExist = True Else CheckIDExist = False End If End Function الفحص عليك يا معلم @ابو جودي 🤭 ولا تنسى تديني 10 / 10 😅👊

والسؤال الان للباش مهندس @Moosak فاكر الكود الذكى بتاع الترقيم التلقائى تقدر تحول الكود السابق لكود ذكى يتم وضعه فى وظيفة عامة داخل وحدة نمطية ومن خلال متغيرات نقدر نستدعيه لاى جدول واى حقل للتأكد من وجود التكرار من عدمه وفى حالة وجود التكرار يذهب للسجل اللى به التكرار يلا شخبط انت المره دى وفرجنا شخابيطك

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

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير افتح الاستعلام فى وضع التصميم واقف على الحقل RSabek هتلاقى موجود به داله DSum RSabek: Nz(DSum("[daen]-[mdeen]";"tblName";"SName='" & [SName] & "' And [id]<" & [id]);0) جمع حقل الدائن ناقص المدين من الجدول بشرط الاسم يكون مساوى للاسم بالاضافه لرقم العمليه اللى هو الترقيم التلقائى اقل من الرقم اللى قبله , ويمكن استعمال التاريخ بدلا منه وفى حقل Rseed Rseed: ([RSabek]+[Daen])-[Mdeen] قمنا بجمع الرصيد السابق + الدئن ناقص المدين ومرفق تعديل للمثال باستخدام التاريخ بدلا من الترقيم التلقائى RSabek: Nz(DSum("[daen]-[mdeen]";"tblName";"SName='" & [SName] & "' And [SDate]<" & Format([SDate];"\#mm\/dd\/yyyy\#"));0) بالتوفيق TestRseedSabk_ByDate.accdb

بارك الله فيك على هذا التوضيح السلس والواضح .. ودمتم برعاية الله وتوفيقه ..

جزاك الله خيرا اخى واستاذى محمد @ابو جودي 🌹 من فضلك ارسل لى

والعبقرية هي فضل من الله يا عبقري 👍🏼😉

تفضل هذه الجزئية DateDiff('yyyy',[EmpBirthDate],Now()) Between " & _ Me.txtFrom & " And " & Me.txtTo

تطبيق الفاتورة الاكترونية حسب متطلبات هيئة الزكاة و الضريبة السعودية كما انه تم الاستفادة من الكود الخاص بالأستاذ / @ابو جودي رابط الموضوع يمكن التجربة من خلال الرابط التالي InvoiceSA.somee.com كما يمكن تحميل المشروع للمطورين من خلال الرابط اعلاه

رائع استاذ مجدى بارك الله فيك وتقبل الله منك سائر الأعمال

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

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

نعم ممكن اختزاله ... وذلك بتعديل مسميات مربعات النص قليلا .... انظر الكود وحاول قرائته ..... وسوف ارفق المرفق قريبا ..... myT = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس") For Each t In myT If Me.to.Value = t Then For i = 1 To 8 If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] =" & i), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] =" & i), "hh:mm:ss AMPM") Then Me.Controls(t & i).BackColor = vbYellow End If Next i End If Next t

هل تقصد كده مثلا ........... If Me.to.Value = "الأحد" Then If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 1"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 1"), "hh:mm:ss AMPM") Then Me.bac1.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 2"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 2"), "hh:mm:ss AMPM") Then Me.bac2.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 3"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 3"), "hh:mm:ss AMPM") Then Me.bac3.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 4"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 4"), "hh:mm:ss AMPM") Then Me.bac4.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 5"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 5"), "hh:mm:ss AMPM") Then Me.bac5.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 6"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 6"), "hh:mm:ss AMPM") Then Me.bac6.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 7"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 7"), "hh:mm:ss AMPM") Then Me.bac7.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 8"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 8"), "hh:mm:ss AMPM") Then Me.bac8.BackColor = vbYellow End If ElseIf Me.to.Value = "الإثنين" Then If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 1"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 1"), "hh:mm:ss AMPM") Then Me.bac9.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 2"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 2"), "hh:mm:ss AMPM") Then Me.bac10.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 3"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 3"), "hh:mm:ss AMPM") Then Me.bac11.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 4"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 4"), "hh:mm:ss AMPM") Then Me.bac12.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 5"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 5"), "hh:mm:ss AMPM") Then Me.bac13.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 6"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 6"), "hh:mm:ss AMPM") Then Me.bac14.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 7"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 7"), "hh:mm:ss AMPM") Then Me.bac15.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 8"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 8"), "hh:mm:ss AMPM") Then Me.bac16.BackColor = vbYellow End If ElseIf Me.to.Value = "الثلاثاء" Then If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 1"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 1"), "hh:mm:ss AMPM") Then Me.bac17.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 2"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 2"), "hh:mm:ss AMPM") Then Me.bac18.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 3"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 3"), "hh:mm:ss AMPM") Then Me.bac19.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 4"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 4"), "hh:mm:ss AMPM") Then Me.bac20.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 5"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 5"), "hh:mm:ss AMPM") Then Me.bac21.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 6"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 6"), "hh:mm:ss AMPM") Then Me.bac22.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 7"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 7"), "hh:mm:ss AMPM") Then Me.bac23.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 8"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 8"), "hh:mm:ss AMPM") Then Me.bac24.BackColor = vbYellow End If ElseIf Me.to.Value = "الأربعاء" Then If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 1"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 1"), "hh:mm:ss AMPM") Then Me.bac25.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 2"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 2"), "hh:mm:ss AMPM") Then Me.bac26.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 3"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 3"), "hh:mm:ss AMPM") Then Me.bac27.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 4"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 4"), "hh:mm:ss AMPM") Then Me.bac28.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 5"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 5"), "hh:mm:ss AMPM") Then Me.bac29.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 6"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 6"), "hh:mm:ss AMPM") Then Me.bac30.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 7"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 7"), "hh:mm:ss AMPM") Then Me.bac31.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 8"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 8"), "hh:mm:ss AMPM") Then Me.bac32.BackColor = vbYellow End If ElseIf Me.to.Value = "الخميس" Then If Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 1"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 1"), "hh:mm:ss AMPM") Then Me.bac33.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 2"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 2"), "hh:mm:ss AMPM") Then Me.bac34.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 3"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 3"), "hh:mm:ss AMPM") Then Me.bac35.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 4"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 4"), "hh:mm:ss AMPM") Then Me.bac36.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 5"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 5"), "hh:mm:ss AMPM") Then Me.bac37.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 6"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 6"), "hh:mm:ss AMPM") Then Me.bac38.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 7"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 7"), "hh:mm:ss AMPM") Then Me.bac39.BackColor = vbYellow ElseIf Format(Me.from, "hh:mm:ss AMPM") >= Format(DLookup("from", "timing", "[period] = 8"), "hh:mm:ss AMPM") And Format(Me.from, "hh:mm:ss AMPM") < Format(DLookup("to", "timing", "[period] = 8"), "hh:mm:ss AMPM") Then Me.bac40.BackColor = vbYellow End If End If

طيب جرب لجميع الايام .... لكن الكود كتبته للاسف طويل ويمكن اختزاله .... If Me.to.Value = "الأحد" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac1.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac2.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac3.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac4.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac5.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac6.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac7.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac8.BackColor = vbYellow End If ElseIf Me.to.Value = "الإثنين" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac9.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac10.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac11.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac12.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac13.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac14.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac15.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac16.BackColor = vbYellow End If ElseIf Me.to.Value = "الثلاثاء" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac17.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac18.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac19.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac20.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac21.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac22.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac23.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac24.BackColor = vbYellow End If ElseIf Me.to.Value = "الأربعاء" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac25.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac26.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac27.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac28.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac29.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac30.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac31.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac32.BackColor = vbYellow End If ElseIf Me.to.Value = "الخميس" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac33.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac34.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac35.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac36.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac37.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac38.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac39.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac40.BackColor = vbYellow End If End If ‏‏timetable 2022 (3) 3.accdb لي ملاحظات عامة سريع على برنامجك بشكل سريع :::::::::: اولا لو تم تعديل فترات الحصص مستقبلا ... سوف تضطر الى الدخول للكود وتعديله .... الحل ان يكون الكود مرتبط بالجدول الخاص بالحصص بحيث لو تم التعديل عليه يتعدل الكود مباشرة ... ثانيا في النموذج ايضا مربعات التسمية لفترات الحصص نفس المشكلة الاولى .... فالمفوض ترتبط بالجدول بحيث انك تعدل مرة واحده وليس كل مرة تدخل الى وضع تصميم النموذج للتعديل ... هذا ما يحضرني من ملاحظات الان ... واذا ظهر لي ملاحظات اخرى سوف اذكرها ...

أكرمك الله استاذ ماجد ... بارك الله فيك

أحسنت استاذ مجدى عمل ممتاز جعله الله فى ميزان حسناتك وتقبل الله منك سائر الأعمال وكل عام وانتم بخير

طيب جرب يوم الاحد كدة ...... If Me.to.Value = "الأحد" Then If Me.from >= #7:20:00 AM# And Me.from < #8:05:00 AM# Then Me.bac1.BackColor = vbYellow ElseIf Me.from >= #8:05:00 AM# And Me.from < #8:50:00 AM# Then Me.bac2.BackColor = vbYellow ElseIf Me.from >= #8:50:00 AM# And Me.from < #9:35:00 AM# Then Me.bac3.BackColor = vbYellow ElseIf Me.from >= #9:35:00 AM# And Me.from < #10:20:00 AM# Then Me.bac4.BackColor = vbYellow ElseIf Me.from >= #10:45:00 AM# And Me.from < #11:30:00 AM# Then Me.bac5.BackColor = vbYellow ElseIf Me.from >= #11:30:00 AM# And Me.from < #12:15:00 PM# Then Me.bac6.BackColor = vbYellow ElseIf Me.from >= #12:15:00 PM# And Me.from < #1:00:00 PM# Then Me.bac7.BackColor = vbYellow ElseIf Me.from >= #1:00:00 PM# And Me.from < #1:45:00 PM# Then Me.bac8.BackColor = vbYellow End If End If timetable 2022 (3) (1).accdb

طيب جرب كده ..... timetable 2022 (3).accdb

تفضل تم التعديل كما تريد كما تم توضيح كيفية زيادة الحقول كما تشاء بصورة توضيحية .. وأعتقد ان هذا يكفى حتى يتم اغلاق المشاركة نموذج ادخال البيانات2.xlsm