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

السلام عليكم ورحمة الله تعالى وبركاته وردنى السؤال الآتى عند فتح نموذج او تصفح بيانات من استعراض السجلات من خلال نموذج فى حالة التركيز على عنصر تحكم ما قد يتم اضاقة شئ بالخطأ الى البيانات او حذف شئ من البيانات هل ممكن تأمين جميع الحقول بحيث لا يمكن التعديل او حذف او اضافة بيانات بالخطأ الاجابة نعم ممكن ذلك بكل سهولة من خلال الفكرة الاتية بترتيب الخطوات إنشاء زر امر ونسمى زر الامر cmdEdit نقوم بتسمية زر الامر بـ Edit نضع الكود الاتى فى حدث الحالى للنموذج If Me.NewRecord Then With Me .cmdEdit.Caption = "Edit" .cmdEdit.ForeColor = 0 .cmdEdit.FontBold = False .AllowEdits = True .cmdEdit.Enabled = False End With Else With Me .AllowEdits = False .cmdEdit.Caption = "Edit" .cmdEdit.ForeColor = 0 .cmdEdit.FontBold = False .cmdEdit.Enabled = True End With End If نضع الكود الاتى فى حدث عند النقر لزر الامر Select Case Me.cmdEdit.Caption Case "Edit" With Me .AllowEdits = True .cmdEdit.Caption = "Lock" .cmdEdit.ForeColor = 255 .cmdEdit.FontBold = True .Refresh End With Case "Lock" With Me .AllowEdits = False .cmdEdit.Caption = "Edit" .cmdEdit.ForeColor = 0 .cmdEdit.FontBold = False .Refresh End With End Select المرفق Securing records.accdb

السلام عليكم .. الاساتذة الكرام الموضوع اليوم عن تتبع التغييرات التى تقوم بها على اى سجل موجود فى قاعدة البيانات .. لنبدأ لنفترض ان لدى مجموعة من النماذج التى تقوم بتعديل بيانات معينة فى الجداول واريد ان اتتبع التغييرات التى تمت بحيث يتم تسجيل البيانات قبل التعديل وبعد التعديل مثال : لدى هذا النموذج ومهمته التعديل على رصيد المخزن .. انظر للقيمة قبل التعديل : قمت بالتعديل وضغطت على زر الأمر .. النتيجة .. فى جدول التعديلات TblAudit تم تسجيل التالى : القيمة قبل التعديل وبعد التعديل .. والشخص القائم بالتعديل .. وتاريخ ووقت التعديل .. و النموذج المستخدم فى التعديل .. ومصدر بيانات هذا النموذج . فلنجرب تعديل اكثير من حقل فى النموذج دفعة واحدة : النتيجة : تابع معى لتعرف الطريقة : مبدأياً لم اكتب الكود ولكن قمت بالتعديل عليه وعملت امثلة مصمم الكود كتبت اسمها فى الكود نفسه .. افتح موديول جديد والصق هذا الكود : Public Function WriteAudit(frm As Form, lngID As Long) As Boolean On Error GoTo err_WriteAudit Dim ctlC As Control Dim strSQL As String Dim bOK As Boolean bOK = False DoCmd.SetWarnings False ' For each control. For Each ctlC In frm.Controls If TypeOf ctlC Is TextBox Or TypeOf ctlC Is ComboBox Then If ctlC.Value <> ctlC.OldValue Or IsNull(ctlC.OldValue) Then If Not IsNull(ctlC.Value) Then strSQL = "INSERT INTO tblAudit ( ID, FieldChanged, FieldChangedFrom, FieldChangedTo, User, DateofHit, FrmName , FrmRcrdSrc ) " & _ " SELECT " & lngID & " , " & _ "'" & ctlC.Name & "', " & _ "'" & ctlC.OldValue & "', " & _ "'" & ctlC.Value & "', " & _ "'" & GetUserName_TSB & "', " & _ "'" & Now & "' , " & _ "'" & M & "', " & _ "'" & R & "'" 'Debug.Print strSQL DoCmd.RunSQL strSQL End If End If End If Next ctlC WriteAudit = bOK exit_WriteAudit: DoCmd.SetWarnings True Exit Function err_WriteAudit: MsgBox Err.Description Resume exit_WriteAudit End Function اذا اردت ان تنادى هذا الكود يتم بهذه الطريقة WriteAudit(Form Name, Record ID) مثلا كالتالى فى زر امر : On Error GoTo Err_cmdClose_Click If Not IsNull(Me!ID) Then M = Me.Name ' Debug.Print M R = Me.RecordSource ' Debug.Print R X = WriteAudit(Me, Me!ID) End If DoCmd.Close Exit_cmdClose_Click: Exit Sub Err_cmdClose_Click: MsgBox Err.Description Resume Exit_cmdClose_Click ملاحظة : - يمكن استخدام الكود فى اى نموذج يقوم بتعديل البيانات وسيقوم الكود بتسجيل التعديلات وبياناتها كما اشرت سابقاً. قام استاذنا جعفر @jjafferr بعمل موضوع رائع مشابه فى الفكرة ولكن يقوم بتسجيل التعديلات التى تتم على الجداول عن طريق الماكرو يمكنك مشاهدته من هنا : مرفق مثال به نموذجين وتم استخدام نفس الاكواد فيهما .. دمتم بود Dynamic Audit Trail - Amr Ashraf.accdb

السلام عليكم ورحمة الله اخى الكريم اليك ملف الصف الاول و للعلم انا اعمل علية من بعد توقيت الموضوع بفترة وجيزة و لكن العمل على شيت جديد اهون كثيرا من اصلاح او تعديل شيت قديم اما شيت الدور الثانى فارجو امهالى من الوقت ما يكفى الا اذا كنت مستعجل فشيت الصف الثانى اصعب بكثير و الله ولى التوفيق 879671290_-201999.xlsm

Sub Test() Const sRow As Integer = 4, eRow As Integer = 18 Dim x, r As Long, cnt As Long Application.ScreenUpdating = False With ActiveSheet For r = sRow To eRow cnt = cnt + 1 x = Application.Match(.Cells(r, 2).Value, .Columns(14), 0) If Not IsError(x) Then .Cells(x, 14).Resize(, 11).Cut If r <> x Then .Cells(r, 14).Insert Shift:=xlDown Else .Cells(r, 2).Resize(, 11).Cut .Cells(.Cells(Rows.Count, 2).End(xlUp).Row + 1, 2).Insert Shift:=xlDown If cnt = eRow Then Exit For r = r - 1 End If Next r End With Application.ScreenUpdating = True End Sub

هو مش عارف انت مين واللا ايه علشان يقول لك كده المرفق اهون ياسيدى ToolTip.mdb

وتفضل هذه محاولة اخرى MEDATA.zip

مشاركة مع اخي استاذ حسام MEDATA-1.accdb

السلام عليكم تفضل هذه المحاولة ارجو ان تكون موفقة MEDATA-2.rar

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

حياك الله .... اولا جعلنا مصدر بيانات الكمبوبكس الخاص باسم الموظف استعلام ثم في حدث نعد التحديث لنفس الكمبو جعلنا الكود الذي رأيت و Column(2) يعني الحقل الثالث في الاستعلام المذكور Column(0) يعني الحقل الاول وهكذا استطعنا اسناد قيم الحقول الى مربعات النص في النموذج ...

بسم الله الرحمن الرحيم.. السلام عليكم ورحمة الله وبركاته.. بعد طول غياب عن الساحة بسبب ضروف الحياة والعمل.. اقدم لكم اداة صغيرة من برمجتي بلغة Visual Studio .NET تقوم بالتقاط الصور كاميرا الويب او اي كاميرا متصلة بالكومبيوتر ومن ثم خزنها في الجهاز الاداة قمت بربطها مع الاكسس، بحيث تقوم بتمرير براميتر من الاكسس الى الاداة وهذا البراميتر متمثل بـ مسار حفظ الصورة + واسم الصورة + صيغتها مثال: Dim SavedPath As String SavedPath = """" & CurrentProject.Path & "\Capture.png" & """" الاداة تستخدم مكتبات AForge للتحكم بالكاميرات. صورة الاداة: بمجرد ان تضغط زر Open Camera من الاكسس ستعمل الاداة مباشرة قم بترتيب الكاميرا الخاصة بك لاخذ لقطة مناسبة واضغط على الزر Snapshot ثم اضغط على الز save لحفظ الصورة. الاداة اخذت مني وقت 8 ساعات في البرمجة لذلك لا تنسوني ووالدي من صالح دعائكم. تم بحمد الله. SEMO_webCam.rar كلمات مفتاحية: التقاط صورة من الكاميرا، حفظ الصورة من الكاميرا، جلب الصورة من كاميرا الويب، جلب الصورة من الكاميرا وحفظها في قاعدة البيانات، حفظ الصور بقاعدة البيانات، خزن الصورة من الكاميرا كاميرا ويب قاعدة بيانات اكسس، اكسس كاميرا الويب، اكسس كاميرا، جلب الصورة من الكاميرا

السلام عليكم .. الاخوان الاعزاء سؤال من باب الترفيه والتسلية وتشارك الافكار فى نفس الوقت كيف يتم عمل التالى بدون اكواد طبعاً فى الآخر هقول الطريقة اللى عملتها بها بس اسمع آراء الاخوة دمتم بخير

مشكور استاذي الفاضل قلب الأسد

سلمت يا مدير كثر الله خيرك 🏝️

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

المعلومة كاملة هنا جعفر

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

ShortcutMenu = False للاظهار ShortcutMenu = True

أخ محمد .. ( بحذف أفضل إجابة وقد أجبتك بشكل يرضيك ) اولا لست من ينكر الحق لاهله ولم اقم بحذف اي افضل اجابه او اي شئ اخر .. واما قولك ( واقترحت عليك كتابة موضوع آخر تصف فيه طلبك الجديد) فلم اقراه الا الان عند كتابة هذا الرد ثانيا .. قد اكون لم اوصل لك وللاخوه ما اريد ..بمعنى مختصر ( لكل عميل متأخرات .. فالذي اريده ان عند الدخول للعمل 100 مثلا تظهر متأخراته .. وعند الدخول للعميل 200 تظهر ما عنده متأخرات ) دمت بحفظ الله ورعايته

اهم شئ فنجان القهوة , يتحرق الكود ولا يهمك 😅

حينما فتحت الموديول اردت تحويل المعرف الى string لكن دقائق مع فنجان القهوة ونسيت كل شيء 🤔

السادة الافاضل .. بالنسبة لمشكلة عدم عمل الكود على النموذج الفرعى Subform تم حلها بدون تعديل فى الموديول .. شرح الحل اذا قمت بمناداة الموديول عند حدث بعد التحديث لحقول النموذج الفرعى فما سيتم انه سيقوم بالحاق نفس السجل متكرر بنفس عدد التعديلات وبالتالى اذا قمنا ب4 تعديلات فإن اول 3 تعديلات سيتم تكرارهم 4 مرات والتعديل الاخير لن يتم تكراره وذلك لأن القيم المخزنة هى قيم السجل بالكامل وليس حقل واحد وبالتالى عند الحاقها بالجدول سيقوم بتقسيم السجل الى سطور وبهذا يتم التكرار .. انظر للمثال كما تلاحظ تم تكرار التعديل الاول مرتين والثانى لم يتم تكراره لأن ليس هناك تعديلات بعده وبالتالى لكى تعمل الطريقة يجب ان يتم استدعاء الكود فى حدث Before Update للنموذج الفرعى نفسه وليس الحقول بداخله وايضا نفس الموضوع للنموذج الرئيسى وبهذا سيقوم بتسجيل التعديلات التى تتم على النموذج الرئيسى والنموذج الفرعى وذلك بدون تعديل على الاكواد فى شئ . مرفق التعديل على مرفق الاستاذ @moamen salem , انظر التعديل @عمر ضاحى Dynamic Audit Trail + Subforms - Amr Ashraf v3.0.accdb

تم الحل و لله الحمد و الشكر و الشكر للأستاذ حسام أسأل الله له الجنة حيث عدلت الكود في الوحدة النمطية ليصبح على الشكل التالي : For i = 1 To k If XSum = "" Then XSum = Trim(XSum & Rs!mon & " " & Rs!not1) Else XSum = XSum & " + " & Rs!mon & Rs!not1 End If Rs.MoveNext Next i جزاك الله أستاذ د.كاف يار أسأل الله لك الأجر و الثواب ألف شكر لحضرتك أستاذ Eng.Qassim زادنا الله و إياكم من علمه ..

السلام عليكم ورحمة الله وبركاته أرجو أن تكون النتيجة مقبولة باستخدام Pivot table فرز وجمع.xlsx

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

صحيح ما قلت أخي الكريم، وما فعلته من كثافة في التنسيقات الشرطية لسببين: 1- أنه بالاجتهاد يمكننا تحقيق ما نريد حيث قمت بتغيير فكرة البناء على التنسيق المسبق من قبل الأخ صاحب السؤال. 2- أخي صاحب السؤال دون أن يقوم بتجربة الملف حسب التنسيق الذي أجريته قال أنه يستخدم لمرة واحدة وواقع الحال ينبئ باستخدام جداول عديدة. هذا فقط ما أردت إيضاحه لكم .... مع العلم أنني أضع علمك ومساعدتك للآخرين فوق رأسي فأنت أخي الكريم - ومن خلال متابعتي لإجاباتكم الرائعة - بمثابة القلب النابض في منتدى الإكسيل وأنا أغبطك على ذلك تقبل تحياتي العطرة لشخصكم الكريم والسلام عليكم ورحمة الله وبركاته.

وعليكم السلام.. انظر للمرفق اخي العزيز واختار دولة وعند الضغط على الزر سيتم الترحيل لكن السؤال لماذا تريد الترحيل لكل جدول باسم الدولة؟ هذا يعني ستحتاج للعديد من الجداول Database51.accdb

Great solution but the heavy use of conditional formatting will make the file slow and heavy and at the same time will make the file size larger

لعلك صديقي العزيز لم تجرب المعادلة فقلت أنها بصراحة فكرة أن تعمل جدول اعتماداً على كتابة بيانات محددة أو رؤوس أعمدة للجدول جيدة. وهي بالأكواد أفضل، وكما أخبرنا الأخ المحترم lion heart أن الحدود غير دقيقة بالتنسيق الشرطي كلامه صحيح في حال اعتمدنا على التنسيق المسبق من قبلكم وإلغاء التنسيق من الصفوف الفارغة ولكن ماذا لو عكسنا المعادلة بحيث تكون الورقة خالية من التنسيقات ثم نقوم بتنسيقها(تنسيقات شرطية) حسب الجداول مع تمييز رؤوس الجداول بألوان وتنسيقات محددة تميزها عن البيانات المعطاة في الجداول، وحدود واضحة، أما مدى إنشاء الجداول ليس كما ذكرت - لمرة واحدة - بل مرات عديدة حتى نهاية الصفوف في الورقة كاملة ضمن عدد معلوم للأعمدة. تقبلوا تحياتي العطرة والسلام عليكم test.xlsx

وعليكم السلام 🙂 تفضل ، هذه احد الطرق لأخونا @Amr Ashraf جعفر

وسوف نحاول ونحاول ونحاول .... ونرحع للمنتدى

حقيقة تعجز الكلمات عن الشكر ... هذا المطلوب دمت رائع محبوب الخصال

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

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

السلام عليكم اخي الحبيب ابو الحسن تم التعديل على اساس ان رقم الحساب واسمه ونوعه في جدول واحد وهو جدول الحسابات ومربوط بعلاقة مع جدول انواع الحسابات واذا كانت هذه الخطوة صحيحة وهي طلبك فعليه يجب التعامل مع رقم الحساب فقط في بقية الجداول والاستعلامات والنماذج ومنه تستطيع استدعاء اسم الحساب ونوعه وهذا ما تم عمله من تعديلات على الجداول والنماذج والاستعلامات والامر لا يخلو من المراجعة والتدقيق وعذرا للتقصير الدائن و المدين-1.rar

حبيبى استاذ حسام الكريم والله يعمل لدى تمام مش عارف ايه سبب عدم عمله عند حضرتك ربنا يحفظك من اى شر يارب

يبقى من المناقشات يا اخوان استنتجنا ان هناك طريقتين بدون اكواد لعمل المطلوب : الطريقة الاولى كما قال الاستاذ @ناقل والاستاذ موسى على خطوتين الخطوة الاولى كتابة العنوان فى حقل التنسيق فى خصائص الكومبوبوكس Format كالتالى @;"العنوان المطلوب" والخطوة الثانية تنسيق شرطى للكومبوبوكس فى حالة الفراغ كالتالى Expression Is IsNull([Combo])=True واختر التنسيق المطلوب . ملاحظات على الطريقة : تنسيق العنوان سيكون مثل تنسيق القائمة من حيث حجم الخط و المحازاة و مائل او عريض Bold . لن يمكنك تحديد تنسيق مختلف للعنوان فى هذه الحالة . الطريقة الثانية : طريقة العباقرة كما كشفها الاستاذ @أبو عبدالله الحلوانى عمل ليبل على القائمة وتحديد موقعه Bring To Front او جلب للأمام وممكن نزود حتة كود صغير After Update كالتالى 😄 If Not IsNull(Me.Combo0) Then Me.Label2.Visible = False Else Me.Label2.Visible = True End If طبعا خاصية Bring to Front او Send to Back لا يتم استخدامها الا فى وضع التصميم Design View وبالتالى سنستعين بخاصية الاظهار للعناصر للتحكم فى وقت ظهور واختفاء الليبل ولتكون النتيجة كما فى اول الموضوع . المزايا فى هذه الطريقة ان يمكنك تحديد تنسيق مختلف للعنوان من حيث حجم الخط او المحازاة او نوع الخط وهكذا . سامحونى على الطريقة من باب التسلية والنقاش بين الاخوة مرفق مثال به الطريقتين دمتم بخير Combo box Title.accdb

عملت تغيير على الكود ليصبح: Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) Dim i As Integer, UB As Integer Dim x() As String Dim L As Single, T As Single, W As Single, H As Single x = Split(Me.Ev, Chr(13)) UB = UBound(x) If UB = 0 Then Exit Sub L = Me.Ev.Left T = Me.Ev.Top W = Me.Ev.Width H = (Me.Ev.FontSize + 4) * 20 'convert Font size Points to Twips, but the number 4 can be adjusted For i = 1 To UB T = T + H Me.Line (L, T)-(W, T), vbRed 'vbBlack Next i End Sub . والسطر المهم فيه هو ، نأخذ الارتفاع على حسب حجم الخط * 20 (لتحويل حجم الخط الى twips) ، فلا يجب تغيير هذه المتغيرات ، بينما يمكنك تغيير الرقم 4 حسب الحاجة (مع ان تجاربي يتضح منها انه لا يتغير كذلك) : H = (Me.Ev.FontSize + 4) * 20 'convert Font size Points to Twips, but the number 4 can be adjusted . والنتيجة : . او . وحتى اذا جعلنا الخط يساوي 18 نقطة . النتيجة . ونعم ، لتغيير اللون الى اللون الاسود ، بدل vbRed استعمل vbBlack 🙂 جعفر 1468.1.Lines in Report.accdb.zip

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

عليكم السلام ورحمة الله وبركاته .. فى ذيل التقرير انتا كاتب =Nz(Sum([TotalAOT]),0) استبدلها ب =Nz(Sum([Total]),0) النتيجة ا دوال الدمج مثل الجمع والعدد والمتوسط الخ .. فى التقرير ليس باسم عنصر التحكم ولكن باسم مصدر البيانات . بالتوفيق

مثل ما قال الأستاذ ناقل + عمل تنسيق شرطي لتلوين الكومبوبوكس إذا كان فاضي 😁

بالخدمة استاذ

ابدا ... قاعدة If تقوم بالمهمة ...

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

استاذي العزيز تستطيع عمل ذلك من خلال وضع الكود اما بالاستعلام او مصدر بيانات الحقل بالنموذج =NoToTxt([المبلغ];"جنيه";"قرش") تحياتي للجميع Database1.accdb

Not so clear but try this code Sub Test() Const sRow As Integer = 4, eRow As Integer = 18 Dim r As Long, c As Long Application.ScreenUpdating = False With ActiveSheet .Range("B4").CurrentRegion.Sort Key1:=.Range("B4"), Order1:=xlAscending, Header:=xlNo .Range("N4").CurrentRegion.Sort Key1:=.Range("N4"), Order1:=xlAscending, Header:=xlNo .Rows(sRow & ":" & eRow).Interior.Color = xlNone For r = sRow To eRow For c = 2 To 12 If .Cells(r, c).Value <> .Cells(r, c + 12).Value Then .Cells(r, c).Interior.Color = vbCyan .Cells(r, c + 12).Interior.Color = vbCyan End If Next c Next r End With Application.ScreenUpdating = True End Sub

The code is already there in ThisWorkbook module Private Sub Workbook_Open() Application.Visible = False frm_Inventory_Management.Show End Sub

H19في الخلية =IF(I19<>"";"";IF(C19="";"";IF(TODAY()>=h2g(D19);G19;""))) ثم اسحب نزولاً جزاكم الله خيراً على هذا الإطراء الذي لم أرتقِ إليه ....ولكم بمثل ما دعوتم أخي الكريم ...الحمد لله الذي بنعمته تتم الصالحات الحقيقة لم أفهم الطلب جيداً ، لكنني أعتقد أنه إذا كانت تاريخ الدفعة أكبر من تاريخ نهاية العقد (بعده نكتب في الخلية I19 المعادلة التالية: =IF(h2g(D19)>h2g($C$9);$C$11;"") ونسحب نزولاً..... والله أعلى وأعلم ...وحسب اطلاعي على هذا الملف أعجبني تصميمه ومعادلاته وكل ما فيه وفقكم الله تعالى إلى ما يحب ويرضى والسلام عليكم.

Private Sub Worksheet_Change(ByVal Target As Range) Dim sh As Long, v As Long, r As Long, lr As Long, i As Long, ii As Long If Target.Address = "$Q$4" Then Application.ScreenUpdating = False Application.EnableEvents = False Range("A10:T60000") = "" sh = Worksheets.Count: v = 10 For r = 1 To sh If Sheets(r).Name <> ActiveSheet.Name Then lr = Sheets(r).Range("i" & Rows.Count).End(xlUp).Row For i = 10 To lr If Range("Q4") = Sheets(r).Cells(i, 9) Then Cells(v, 1).Resize(, 20).Value = Sheets(r).Cells(i, 1).Resize(, 20).Value v = v + 1 End If Next i End If Next r Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub

وعليكم السلام ورحمة الله وبركاته جرب هذا البرنامج وادعو لاستاذنا جغفر صاحب الموضوع تحياتي