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

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

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

جزاكم الله خيرا استاذ علي على هذا التشريف اسأل الله العظيم رب العرش العظيم ان يوفقنا جميعا لما يحبه ويرضاه بارك الله لك تحياتى الحاره استاذنا الغالى ابو يوسف الله يبارك لك استاذ 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

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

هو أنا هلحق أعمل حاجة قبلك وأنت اللي يسموك @ابو جودي ("قاهر الأكسس")Cstr حتى إني كتبتهالك في دالة 😂 أنت شخص متفجر بالأفكار ما شاء الله عليك 😄 وأنا كمان حاليا شغال على حاجة كبيرة .. سترى النور قريبا إن شاء الله 😉💪🏼

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

ألف ألف مبروك وإلى مزيد من النجاح بإذن ىالله

وعليكم السلام .. هذا ممنوع بمنتدانا فهذا يعتبر حق ملكية فكرية لصاحبه فقط ... فعليك بالإتصال مباشرة بصاحب ومؤلف هذا العمل .. وشكراً جزيلاً !!!

أشكرك أخي الكريم @Hicham1470 بل أنت من يستحقها في هذه المرة،جزاكم الله خيراً. والسلام عليكم

بارك الله فيك أخي أبا الحسن ،، تتبعت مصدر البيانات التي في النموذج Form1 ووجدتها تأتي من الجدول Financial_Records.. ولو أمعنت النظر ستجد أن تاريخ أول قيد في 2/7/2021 .. بينما في شاشة البحث في النموذج Form1 البحث يبدأ من 1/7/2021 .. لذلك لن تجد أي رصيد سابق للعملاء بهذه الطريقة وستضل النتيجة تعطيك NULL .. فم هي الآلية التي تريد بها الحصول على الرصيد السابق للعميل ؟ وكيف سيتم التمييز بين العملاء ؟ باسم العميل أم برقم العميل ؟ ماهي الخانة التي سأربط بها بين العميل ورصيده ؟ تحتاج لكمّ جيد من البيانات التجريبية في الجداول لكي تستطيع تجربتها عند تصميم قاعدة البيانات .

وعليكم السلام ضع حقل غير منظم في النموذج واعطة اسم كمثال textpassword ثم ضع الكود التالي عند الحذف if me.textpassword = 9999 then DoCmd.RunCommand acCmdDeleteRecord else msgbox "error password" end if ستكون كلمة السر 9999 وهناك طرق اخرى حسب احتياجك

السلام عليكم ورحمة الله وبركاته يمكنك استخدام عمود مساعد تجمع فيه بين الاسم وشيء آخر كالرقم مثلاً ..إلخ. ثم ليكن هذا العمود ما تجري عليه الفلترة والله اعلم والسلام عليكم ورحمة الله وبركاته

الحمد لله الذي بنعمته تتم الصالحات

كما فهمت الموضوع Sub Test() Range("H2").Formula = "=VLOOKUP($A$2:$A$13,data!$A$1:$H$540,8,0)" Range("H2").AutoFill Destination:=Range("H2:H" & Cells(Rows.Count, 1).End(xlUp).Row) a = Sheets("Feuil1").Cells(1).CurrentRegion For i = 2 To UBound(a) With Sheets(a(i, 8)) x = .Cells(Rows.Count, 1).End(xlUp).Row + 1 For ii = 1 To UBound(a, 2) .Cells(x, ii) = a(i, ii) Next End With Next Range("H:H").ClearContents End Sub

ما شاء الله! تبارك الله! جعله الله تعالى شاهِدًا وحُجّةً وبرهانًا. واللهم صلّ وسلّم على نبيّنا مُحمّد، وارضَ عن صحابته الأخيار.

السلام عليكم ورحمة الله وبركاته يمكنك استخدام المعادلة التالية واسحب نزولاً =SUM((B2*30);A2) تقبل تحياتي العطرة

Sub Test() Dim a, x, e, v, wsData As Worksheet, wsExisting As Worksheet, wsA As Worksheet, wsF As Worksheet, wsM As Worksheet, sh As Worksheet, i As Long, ii As Long, k1 As Long, k2 As Long, k3 As Long, n As Long Application.ScreenUpdating = False Set wsData = ThisWorkbook.Worksheets("Data") Set wsExisting = ThisWorkbook.Worksheets("Feuil1") Set wsA = ThisWorkbook.Worksheets("ARABE") Set wsF = ThisWorkbook.Worksheets("FRANCAIS") Set wsM = ThisWorkbook.Worksheets("MIXTE") a = wsData.Range("A2:H" & wsData.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim b1(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) ReDim b2(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) ReDim b3(1 To UBound(a, 1), 1 To UBound(a, 2) - 1) For i = LBound(a, 1) To UBound(a, 1) x = Application.Match(a(i, 1), wsExisting.Columns(1), 0) If Not IsError(x) Then GoTo NXT If a(i, 8) = "ARABE" Then k1 = k1 + 1 For ii = 1 To 7 b1(k1, ii) = a(i, ii) Next ii ElseIf a(i, 8) = "FRANCAIS" Then k2 = k2 + 1 For ii = 1 To 7 b2(k2, ii) = a(i, ii) Next ii ElseIf a(i, 8) = "MIXTE" Then k3 = k3 + 1 For ii = 1 To 7 b3(k3, ii) = a(i, ii) Next ii End If NXT: Next i For Each e In Array(1, 2, 3) If e = 1 Then Set sh = wsA: n = k1: v = b1 ElseIf e = 2 Then Set sh = wsF: n = k2: v = b2 ElseIf e = 3 Then Set sh = wsM: n = k3: v = b3 End If If n > 0 Then sh.Range("A1").CurrentRegion.ClearContents sh.Range("A1").Resize(, 7).Value = wsData.Range("A1").Resize(, 7).Value sh.Range("A2").Resize(UBound(v, 1), UBound(v, 2)).Value = v End If Next e Application.ScreenUpdating = True End Sub

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

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

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

Sub Test() GenerateUniqueRandom ActiveSheet, "D3:F22", 1, 60 End Sub Sub GenerateUniqueRandom(ByVal shTarget As Worksheet, ByVal sRng As String, ByVal iStart As Long, iEnd As Long) Dim w, v, rng As Range, c As Range, n As Long, i As Long, ii As Long, r As Long Set rng = shTarget.Range(sRng) If iEnd - iStart + 1 > rng.Cells.Count Then MsgBox "Generated Numbers Greater Than Range Cell Count", vbExclamation: Exit Sub w = Evaluate("ROW(" & iStart & ":" & iEnd & ")") n = 0 ReDim v(1 To rng.Rows.Count, 1 To rng.Columns.Count) For i = LBound(v, 1) To UBound(v, 1) For ii = LBound(v, 2) To UBound(v, 2) r = Application.RandBetween(iStart, UBound(w) - n) v(i, ii) = w(r, 1) w(r, 1) = w(UBound(w) - n, 1) n = n + 1 Next ii Next i rng.Cells(1).Resize(UBound(v, 1), UBound(v, 2)).Value = v End Sub

تفضل يمكنك استخدام هذه الدالة المعرفة =RandomNumbers(1,60,0) Public Function RandomNumbers(Num1 As Long, Num2 As Long, Optional Decimals As Integer) Application.Volatile Randomize If IsMissing(Decimals) Or Decimals = 0 Then RandomNumbers = Int((Num2 + 1 - Num1) * Rnd + Num1) Else RandomNumbers = Round((Num2 - Num1) * Rnd + Num1, Decimals) End If End Function عدم التكرار.xlsm

السلام عليكم ورحمة الله وبركاته.. اقدم لكم مجموعة من واجهات المستخدم (user interface) عسى ان تفيدكم في تحسين مظهر البرامج الخاصة بكم. المصدر: https://github.com/krishKM/Modern-UI-Components-for-VBA لا تنسوني ووالدي من صالح دعائكم.. تحميل المرفق الأول: sample_x64.zip تحميل المرفق الثاني: sample_x86.zip

وعليكم السلام -يجب عليك التمهل .فانت لا تعرف مدى انشغال الأساتذة - تفضل تم التعديل فاتورة1.xlsm

تفضل تــم عمل المطلوب -فهذا الكود لزر الخروج من ملف الإكسيل بعد الحفظ Private Sub خروج_Click() ThisWorkbook.Saved = True Application.Quit End Sub كما تم عمل زر بكل صفحة للعودة للصفحة الرئيسية Main كل ما عليك هو الضغط على أيقونة Go To Sheets سيظهر لك مربع حوارى عليك بكتابة اسم الصفحة المراد الوصول لها من خلال الضغط على OK اكواد.xlsm

بارك الله فيك وجزاك الله خير الثواب

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

وعليكم السلام-يمكنك استخدام معادلة المصفوفة (Ctrl+Shift+Enter) =IFERROR(INDEX(LIST!$A$12:$A$230,SMALL(IF(MONTH(LIST!$G$12:$G$230)=MONTH($C$2),ROW(A$12:A$230)-ROW(A$12)+1),ROWS($A$6:A6))),"") 1قائمة.xlsx

وعليكم السلام بعد اذن استاذ محمد ... يمكنك استخدام هذه المعادلة =IF(COUNTIFS($B$2:$B$200,B2,$C2:$C200,C2)>=1,"OK","") data search1.xlsx

وعليكم السلام-يمكنك استخدام هذه المعادلة وبما انك لم تقم برفع الملف.. على سبيل ان الرقم موجود بالخلية A2 , فستكون الإجابة أيضاً بدون ملف =CEILING(A2,0.5)

برنامج مجاني بديل ل SPSS يقوم برنامج PSPP بالعديد من التحليلات التي يقوم بها SPSS و ليس كلها للتحميل من هنـــــــــا