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

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

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

جزاكم الله خيرا استاذ علي على هذا التشريف اسأل الله العظيم رب العرش العظيم ان يوفقنا جميعا لما يحبه ويرضاه بارك الله لك تحياتى الحاره استاذنا الغالى ابو يوسف الله يبارك لك استاذ gamalin

السلام عليكم أخي الكريم هذا المرفق من ملفاتك - أخي الكريم - مع بعض التعديلات أرجو أن يناسبك Private Sub TextBox1_Change() Application.ScreenUpdating = False ActiveSheet.ListObjects("Data").Range.AutoFilter Field:=7, Criteria1:="*" & [e2] & "*", Operator:=xlFilterValues Application.ScreenUpdating = True End Sub TEST.xlsm

السلام عليكم ورحمة الله تعالى وبركاته احيانا نريد عمل معرف خاص بنا برمجيا طبعا يختلف الكود تبعا لاسم الجدول والحقل ونوع الحقل اليوم سوف اقدم لكم فكرتى المتواضعة فى تلك الوظيفة التى يمكن وضعها فى وحدة نمطية ليمكن -استدعاؤها فى زوايا التطبيق المختلفة بكل سهولة -امكانية التحكم اثناء استدعاء الوظيفة فى البادئة ان اردت اضافة بادئة ما -التحكم فى موعد اعادة التعيين ليبدأ العدد من الرقم 1 مرة أخرى سنويا او شهريا او يوميا الكوووووود '|---10/04/2022______________________________________________| '|___www.officena.net________________________________________| '| | '| _ +-----------officena-----------+ _ | '| /o) | ||||| | (o\ | '| / / | @(~O^O~)@ | \ \ | '| ( (_ | _ ----oOo--Moh--oOo----- _ | _) ) | '| ((\ \) +/o)----------3ssam---------(o\+ (/ /)) | '| (\\\ \_/ / \ \_/ ///) | '| \ / \ / | '| \____/________Mohammed Essam________\____/ | '| | '| 10/04/2022 | '| | '|_____www.officena.net______________________________________| '|_____Thank you for visiting https://www.officena.net_______| '======Control in Special increment prefix ID===============================================================================================================================' ' ____ __ ____ ____ __ ____ ____ __ ____ ______ _______ _______ __ ______ _______ .__ __. ___ .__ __. _______ .___________. ' ' \ \ / \ / / \ \ / \ / / \ \ / \ / / / __ \ | ____|| ____|| | / || ____|| \ | | / \ | \ | | | ____|| | ' ' \ \/ \/ / \ \/ \/ / \ \/ \/ / | | | | | |__ | |__ | | | ,----'| |__ | \| | / ^ \ | \| | | |__ `---| |----` ' ' \ / \ / \ / | | | | | __| | __| | | | | | __| | . ` | / /_\ \ | . ` | | __| | | ' ' \ /\ / \ /\ / \ /\ / __| `--' | | | | | | | | `----.| |____ | |\ | / _____ \ __| |\ | | |____ | | ' ' \__/ \__/ \__/ \__/ \__/ \__/ (__)\______/ |__| |__| |__| \______||_______||__| \__| /__/ \__\ (__)__| \__| |_______| |__| ' ' ' '===========================================================================================================================================================================' Function MySpid( _ ByRef strFieldName As String, _ ByRef strTableName As String, _ Optional strPrefixe As String = vbNullString, _ Optional strResetYYorMMorDD As String = "YY", _ Optional nDay As Integer = 0, _ Optional nMonth As Integer = 0, _ Optional nYear As Integer = 0) As String Dim strLinkCriteria As String Dim strOldID As String Dim strNxtID As Long Dim intLenPrefixe As Integer Const intNumberOfZeros = 6 intLenPrefixe = Len(strPrefixe) + 1 If nDay = 0 Then nDay = Format(Date, "dd") If nMonth = 0 Then nMonth = Format(Date, "mm") If nYear = 0 Then nYear = Year(Date) - 2000 Select Case strResetYYorMMorDD Case Is = "YY": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 6), 2), 0) = nYear ' Yearly Reset Case Is = "MM": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 4), 2), 0) = nMonth ' Monthly Reset Case Is = "DD": strLinkCriteria = Nz(Right(Mid(Nz(DLast(strFieldName, strTableName), 0), intLenPrefixe, 2), 2), 0) = nDay ' Daily Reset End Select strOldID = Nz(DLast("" & strFieldName & "", strTableName, strLinkCriteria), 0) strNxtID = CLng(Right(strOldID, intNumberOfZeros)) strNxtID = strNxtID + 1 MySpid = strPrefixe & Format(nDay, "00") & Format(nMonth, "00") & Format(nYear, "00") & _ String(intNumberOfZeros - Len(CStr(strNxtID)), "0") & CStr(strNxtID) End Function يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى MySpid("FldName", "TblName") فى هذه الحالة يتم اعادة تعيين الترقيم سنويا ------------ ولكن للتحكم الكامل ولتغيير الاعدادات MySpid("FldName", "TblName", "AnyPrefixe", "yy or MM OR DD","DayDate","MonthDate","YearDate") AnyPrefixe البادئة التى تريد أن تبدأ الترقيم بها غيرها كما تريد MySpid("FldName", "TblName", "AnyPrefixe") yy or MM OR DD لو اردت اعادة تعيين الترقيم سنويا سوف تكون yy وبدون استخدام هذا الجزء هذا هو الاحتيار المفضل تبعا للكود MySpid("FldName", "TblName", "AnyPrefixe", "yy") لو اردت اعادة تعيين الترقيم شهريا سوف تكون MM MySpid("FldName", "TblName", "AnyPrefixe", "MM") لو اردت اعادة تعيين الترقيم يوميا سوف تكون DD MySpid("FldName", "TblName", "AnyPrefixe", "DD") --------- DayDate لتبدأ الترقيم من خلال رقم يوم محدد يعنى مثلا لو اردنا الترقيم يبدا من يوم 23 MonthDate لتبدأ الترقيم من خلال رقم شهر محدد يعنى مثلا لو اردنا الترقيم يبدا من شهر 09 YearDate لتبدأ الترقيم من خلال رقم سنه محدد يعنى مثلا لو اردنا الترقيم يبدا من عام 21 اجمل الامنيات بالاستمتاع مع هذا الكود وهذه الافكار هذا الاصدار الاول من كتابتى للكود لم اتمكن من التجربة بشكل كبير.. فضلا وكرما موافاتنا بالنتيجة فى حالة حدوث اى خطأ Special increment prefix ID.accdb

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

Congratulations my brother

الف مبروك مزيدا من التألق والإبداع بإذن الله 🤝

الف مبروك والي الامام دائما

الف مبروك والى مزيد من التقدير والتفوق لجميع المشرفين والخبراء

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

السلام عليكم ورحمة الله وبركاته أساتذتي الكرام @lionheart و @omar elhosseini جزاكما الله خيراً على ما تقدمانه من جهود حثيثة ومضنية للناس في حل أسئلتهم واستفساراتهم وإيصالهم للنتائج المرجوة أسأل الله تعالى أن يجعل كل ذلك بموازين حسناتكم يوم لا ينفع مالٌ ولا بنونَ إلا من أتى الله بقلب سليم أما معادلة الأستاذ الكريم @lionheart فهي باستخدام معادلات Filter (لمستخدمي 365) التي لم نرتق لها بعد. حيث لا زلنا على 2016 ومعادلة الأستاذ @omar elhosseini هي باستخدام عمود مساعد ومعادلة Exact حققت نتيجة طيبة. أرجو لكما التوفيق والسداد ...وأشكركما على هذه المعلومات القيمة التي تسدونها لنا والسلام عليكم ورحمة الله وبركاته

الف مبروك و الي الامام دائما باذن الله

من تقدم الى تقدم وان شاء الله ترتقى الى اعلى المراتب

نعم ممكن اختزاله ... وذلك بتعديل مسميات مربعات النص قليلا .... انظر الكود وحاول قرائته ..... وسوف ارفق المرفق قريبا ..... 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

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

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

شكرا لك اخي الكريم ولك مثله اخي هي نفس فكرتك ولكن بطريقة اخري شكرا لك

اخي حل اخر لأثراء الموضوع ضع ما تريد الفلترة عليه في الخلية K1 ثم فلتر العمود F علي ان يساوي TRUE شاهد المرفق اخي Auto_Filter_Case_Sensitive.xlsm

Suppose you have data in range A1 to B20 (Names in first column & Age in second column) Names Age John 41 john 52 Junior 46 junior 37 Lion 33 Lion Heart 15 lion 58 lion heart 39 heart 24 Heart 35 My Heart 18 my heart 14 In cell E1 type the formula (for 365 users) =IF(D1="","",FILTER(A2:B20,ISNUMBER(FIND(D1,A2:A20)),"No Results")) Now you can type in cell D1 File.xlsx

السلام عليكم لدي ملف فاتورة تم عملها من قبل الاستاذ @Eng.Qassim وتم تحديثها واضافة لها اكواد من قبل الاستاذ @د.كاف يار الله يبارك فيهم تم اضافة قائمة منسدلة في الفاتورة لطريقة الدفع (نقدي - اقساط-آجل) المطلوب: بعد تحديث القائمة المنسدلة او بزر الحفظ في نموذج Invoice 1- عند اختيار نقدي سيقوم الزبون بدفع كافة مبلغ الفاتورة اريد ان يكون حقلي (الواصل بالدولار) و (الواصل بالدينار) = مجموع القائمة بالدولار او الدينار وتكون القيمة في حقلي الباقي بالدولار او الدينار= صفر لانه سدد كل المبلغ وتلوينهم بلون معين. 2- عند اختيار آجل (يعني بالدين) الزبون لابدفع اي مبلغ اريد ان يكون حقلي (الباقي بالدولار) و (الباقي بالدينار) = مجموع القائمة بالدولار او الدينار وتكون القيمة في حقلي الواصل بالدولار او الدينار= صفر لانه لم يسدد اي مبلغ وتلوينهم بلون معين. 3- 1- عند اختيار اقساط سيقوم الزبون بدفع جزء من مبلغ الفاتورة اريد ان يكون حقلي (الواصل بالدولار) و (الواصل بالدينار) بلون معين. 4- عمل تحديث للنموذج الرئيس والفرعي تحياتي لكم Database1.rar

وهذا ما فعلته

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

دائما تنزل الميدان بقوة باش مهندس @ابو جودي رااااااااااااائع كروعتك .. حاجة كاملة الدسم وشاملة لكل الاحتياجات 😊 دائما تحاول تحط الحلول النهائية لمشاكل الناس .. الله يوفقك يا باشه 😃 >>>>>> يضاف لمكتبة الأكوااااااااااااد 😁👌🏼

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

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

اخي ..انا عملت حسب ما قلت سابقا هل اغير حسب ما تقول الان ما الخطأ في الكود (1).xlsm

عفوا اخي ما الخطأ في الكود (1).xlsm

بسم الله الرّحمن الرّحيم السّلامُ عليكم ورحمة الله تعالى وبركاتهُ بارك الله تعالى بكم إخوتي، وتقبّل طاعاتكم. وأستسمح إخوتي بجعل هذا الموضوع المنفصل؛ عن موضوع التّبليغ السّابق. والأمر مُتعلّقٌ بالتفاعل في الموقِع؛ فليست لديّ تلك الخِبرة في برامج مايكروسوفت. لذلك هل يمكن أن أشارك بنشر الموضوعات والكُتب الإلكترونيّة. وذلك مع الحفاظ على المُلكيّة والعزو للمصدر الأصليّ. علمًا بأنّي أنقُل من مواقع موقوقة ويعرفها المُستخدم العربي؛ فليست بقصد الإشهار. مثال: صيد الفوائِد، وطريق الإسلام، ومثلها. والقصد من ذلك نشر الفائِدة، والإضافة للموقع بإذنِ الله تعالى. وجزاكم الله خيرًا، وباركَ فيكمُ.

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

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

سلمتك ايدكEng.Qassim و تقبل الله صيامك و قيامك استاذي الفاضل و الله يبارك فيك و في اهلك و شكرا لمتابعتك لي

اخي نعم ال VBA لا يعرف المستحيل علشان تبقي اول مرة فب المنتدي

جرب هذا الكود مثلا : 🙂 If Not IsDate(Me.TextBox) Then MsgBox "يجب إدخال تاريخ فقط في هذا الحقل " Undo End If

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

السلام عليكم ورحمة الله وبركاته .. تحية طيبة إخواني .. 🌹 أحضرت لكم اليوم كود وظيفته استخراج الملفات المخزنة في جداول الأكسس كمرفقات داخلية إلى خارج قاعدة البيانات دفعة واحدة 🙂 وهو مفيد جدا لمن لديه قاعدة بيانات قد ملئها بالمرفقات ويحاول الآن تصغير القاعدة باستخراج المرفقات منها وحفظها خارج قاعدة البيانات بسهولة ويسر .. بدل حفظها ملف ملف وهي عملية مرهقة بالتأكيد .. خصوصا إذا كان عدد المرفقات بالمئات .. إليكم الكود : Public Function ExtractAllAttachments(ByVal TableName As String, ByVal AttchmentColumnName As String, ByVal ExtractToFolder As String) ' TableName : اسم الجدول ' AttchmentColumnName : اسم حقل المرفقات ' ExtractToFolder: المكان المراد استخراج الملفات إليه مثال : "C:\ExtractHere" Dim RsMainrecords As dao.Recordset2 Dim RsAttachments As dao.Recordset2 Set RsMainrecords = CurrentDb.OpenRecordset("select " & AttchmentColumnName & _ " from " & TableName & _ " where " & AttchmentColumnName & ".FileName is not Null") Do Until RsMainrecords.EOF Set RsAttachments = RsMainrecords.Fields(AttchmentColumnName).Value Do Until RsAttachments.EOF Dim OutputFileName As String OutputFileName = RsAttachments.Fields("FileName").Value OutputFileName = ExtractToFolder & "\" & OutputFileName RsAttachments.Fields("FileData").SaveToFile OutputFileName RsAttachments.MoveNext Loop RsAttachments.Close RsMainrecords.MoveNext Loop RsMainrecords.Close Set RsMainrecords = Nothing Set RsAttachments = Nothing End Function ويتم تشغيله بالطريقة التالية : ExtractAllAttachments("TableName","AttchmentColumnName","ExtractToFolder") ستحتاج لإعطائه 1- اسم الجدول ، 2 - اسم الحقل ، 3 - المكان الذي تريد استخراج المرفقات فيه . المصدر : https://www.youtube.com/watch?v=jHIgay9goWo

بارك الله فيك استاذ موسى وزادك الله من فضله ... وكل عام وانتم بخير

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

طيب جرب يوم الاحد كدة ...... 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

بعد اذن استاذنا الكريم محمد-يمكنك استخدام هذه المعادلة بالتنسيقات الشرطية =AND(COUNT($A2:$D2)<>0,A2=MAX($A2:$D2)) 111.xlsx

ان شاء الله الحل هنا ان اردت وهو إهداء لمن يريد وهنا كان موضوع البحث والنقاش

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

المعادلة تعمل تمام ... ولكن جربها هكذا =CEILING(ROUND(IF(BL10>10000,(AI10-10000)*0.003+(10000-50)*0.008,IF(AND(BL10>5000,BL10<=10000),(AI10-50)*0.008,IF(AND(BL10>1000,BL10<=5000),(AI10-50)*0.0075,IF(AND(BL10>500,BL10<=1000),(AI10-50)*0.007,IF(AND(BL10>250,BL10<=500),(AI10-50)*0.0065,IF(AND(BL10>50,BL10<=250),(AI10-50)*0.006,0)))))),2),0.05)

الأمر بسيط جداً تفضل ... معادلة بالتأكيد ممتازرة بارك الله فيك استاذ محمد وأكرمك الله 1235.xlsx

وعليكم السلام .دائماً وأبداً ننبه كثيراً على عدم دمج الخلايا لسهولة التعامل مع ملف الإكسيل ,,, تــم الغاء دمج الخلايا لحسن عمل المعادلات وتم وضع كود للطباعة نموذج ادخال البيانات1.xlsm

وعليكم السلام يمكنك ذلك بهذه المعادلة بعد ادخال وكتابة كود الصنف سيتم احضار اسم الصنف وكذلك بمعادلة أخرى إيجاد سعر الصنف =IFERROR(VLOOKUP($C12,'الصنف والسعر'!$A$2:$D$2100,2,0),"") فاتورة جديدة8.xls

تــم التعديل وعلى حد علمى هذا هو المطلوب بالضبط =IF(AND(F$5>$C6,F$5<$B6),$D6,"") 124.xlsx

هذا بالطبع امر طبيعى ومنطقى لأنك تبدأ بعمود العاصمة وليس الدولة فى قاعدة البيانات وهذا اتجاه البحث بالعاصمة أما اذا أردت البحث بالدولة فعليك بإستخدام هذه المعادلة ... فلا يمكن استخدام معادلتك نهائياً عند البحث بالدولة وشكراً =INDEX($B$7:$B$11,MATCH($J7,$C$7:$C$11,0)) test1.xlsx