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

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

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

السلام عليكم ورحمة الله وبركاته نبدأ بعون الله في شرح شيء جديد في عالم البرمجة ، وهو القاموس Dictionary ، وإن شاء المولى يكون مفيد لكم إخواني الكرام. طبعاً عنوان الموضوع جذبكم مش عشان البرمجة أكيد عشان الناموس (وإزاي نقدر نتخلص من الناموس والإزعاج اللي بيسببه ) .. الناموس هنا معناه القانون أو القاعدة .. ودا عنوان كعامل جذب مش أكتر ما هو القاموس Dictionary؟ ---------------------------- من اسمه ممكن نعرفه ..القاموس يعني تجميعة كلمات باللغة الإنجليزية وليها مرادف سواء بنفس اللغة أو بلغة أخرى .. اللي يهمنا في القاموس إني عبارة عن تجميعة Collection القاموس في لغة البرمجة عبارة عن تجميعة ، وبنستخدمه عشان نخزن فيه : أرقام - نصوص - تواريخ - مصفوفات نطاقات - كائنات - متغيرات .. والقاموس عبارة عن عناصر أو بنود Items وكل عنصر له مفتاح مميز Unique Key المفتاح دا فايدته ايه؟ من اسمه بردو نعرف إن المفتاح بيفتح لنا الباب .. بيفتح الباب للعنصر (عشان نتعامل معاه بشكل برمجي .. يعني المفتاح دليلنا أو مرشدنا للعنصر المطلوب التعامل معه) القاموس فايدته إننا بنقدر نتعامل مع البيانات في الذاكرة بعيداً عن ورقة العمل ..يعني مفيش تحديث للشاشة Screen Updating ، مفيش حساب تلقائي Auto Calculation ، بكدا نقدر نفول إنه أسرع في التعامل مع البيانات ++ (فائدة) بما إن القاموس بيحتوي على مفاتيح مميزة ، فيمكن استخدام الخاصية .Keys عشان نستخرج قائمة فريدة Unique List من البيانات ** القاموس ليس ضمن المكتبة القياسية للغة البرمجة VBA ، إنما هي جزء من Microsoft Scripting Runtime library ، وهذه المكتبة توجد في الملف الموجود في المسار التالي \Windows\system32\scrrun.DLL ولذلك إذا أردت استخدام القاموس فيمكنك من خلال محرر الأكواد الذهاب للقائمة Tools ثم References واختر المكتبة المسماة Microsoft Scripting Runtime library إنشاء القاموس Create Dictionary ----------------------------------- أبسط طريقة لإنشاء القاموس استخدام الأسطر التالية With CreateObject("scripting.Dictionary") End With ماذا تعني هذه الأسطر؟ تعني إنشاء كائن جديد بالاعتماد على المكتبة المسماة scripting.Dictionary ، وما بين السطرين سيتم كتابة أسطر وأوامر برمجية الأسطر التي ستبدأ بنقطة تعني التعامل مع خصائص الكائن أي أنها ستتعامل مع الكائن الجديد ## مثال بسيط لإضافة عنصر للقاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" End With الطريقة Method التي تلي النقطة تسمى Add أي أضف .. والمقصود منها إضافة عنصر جديد للقاموس .. ذكرنا في بداية الموضوع أن لكل عنصر مفتاح مميز ، المفتاح هنا First Name ، والعنصر يحتوي على النص Yasser يمكن استخدام متغير للقاموس بهذا الشكل Dim Dict As Object Set Dict = CreateObject("scripting.dictionary") With Dict .Add "First Name", "Yasser" End With الإعلان عن المتغير من النوع كائن ، ثم تعيين قيمة للمتغير ليساوي إنشاء الكائن من المكتبة الخاصة scripting.Dictionary ثم بدء التعامل مع الكائن القاموس .. ## مثال آخر : المثال التالي سيتناول عد العناصر داخل القاموس باستخدام الخاصية Count قم بوضع الكود داخل موديول ثم نفذ الكود ستجد رسالة بها عدد عناصر القاموس وهو في المثال 2 فقط مفتاح العنصر الأول هو First Name ومفتاح العنصر الثاني هو Second Name أما كلمة Yasser وكلمة Khalil فهي محتويات أو عناصر القاموس With CreateObject("scripting.dictionary") .Add "First Name", "Yasser" .Add "Last Name", "Khalil" MsgBox .Count End With وأكتفي بهذ الجزء البسيط .. لكي أجد المتابعة الجيدة منكم وإلى اللقاء في الأسبوع المقبل إن شاء الله مع حلقة جديدة في نفس الموضوع دمتم على طاعة الله

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

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

السلام عليكم أخي الحبيب أبو البراء بدأت الدرر تخرج من أكمامها Smart Indenter من Smart ياسر بارك الله. أعوذ بالله وأعيذكم بالله من الألزهايمر...لأنه مرض أرذل العمر...." لكي لا يعلم من بعد علم شيئا" حيث تفسد الحواس ويختل فيه النظام العقلي والفكري...لا فكر ولا منطق...وقاكم الله منه أخي الحبيب أبو البراء وكل من يقرأ مشاركتي هذه..والسلام عليكم.

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

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا القدير ياسر خليل أبو البراء .. مفاهيم و مصطلحات جديدة بقاموس معرفتنا البرمجيّة البسيطة وناموسها .. دومًا تتحفنا بمفاجآت سارّة .. جزاك الله خيرًا و زادك من علمه و فضله . خالص احتراماتي

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

أحسنت أحسنت أحسنت بارك الله فيك , دائما في القمة لأنك صاحب همة زادك الله من فضله

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

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

السلام عليكم و رحمة الله و بركاته .. بارك الله فيك و لك مقدّمًا ..

السلام عليكم ورحمة الله أخي مصطفى هلال وأهلا بيك بين اخواتك أولا" من تعليمات الموقع ان يكون اسم العضو باللغة العربية وللتسهيل على الاخوة حتى يستطيعوا مساعدتك ان ترفق ملف للعمل علية واخيرا" تفضل اخي المرفق علة يفي بالغرض mywael.rar

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

نعم .. تمام التمام ..بارك الله فيك .. وجعل لك بكل حرف ألف حسنة

وعليكم السلام أستاذ علي عذرا على التأخر في الرد ، كنت في ابوظبي من يوم الاثنين ، وبعيد عن كمبيوتري هذا هو التقرير: . وعلشان يعمل ، فيجب النقر على الزر الجديد لطباعة التقرير: . وهذا الزر يستعمل الكود التالي: Private Sub cmd_rpt_Absent_Late_Click() If Len(Me.cmb_Month & "") = 0 Then MsgBox "Can't leave the Month Empty" Exit Sub ElseIf Len(Me.Grades & "") = 0 Then MsgBox "Can't leave the Grades Empty" Exit Sub ElseIf Len(Me.Sections & "") = 0 Then MsgBox "Can't leave the Sections Empty" Exit Sub End If 'Delete the data from MySQL = "Delete * From tbl_Absent_Late" CurrentDb.Execute (MySQL) DoCmd.SetWarnings fasle 'DoCmd.OpenQuery "Absents_Crosstab_1-3" DoCmd.OpenQuery "Absents_Crosstab_2-3" DoCmd.OpenQuery "Absents_Crosstab_3-3" 'DoCmd.OpenQuery "Late_Crosstab_1-3" DoCmd.OpenQuery "Late_Crosstab_2-3" DoCmd.OpenQuery "Late_Crosstab_3-3" DoCmd.SetWarnings True DoCmd.OpenReport "rpt_Absent_Late", acViewPreview End Sub جعفر 221.Folow up V.2.accdb.zip

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا الفاضل KHMB ..تخمينك طلع مضبوط 200% .. مواضيع كهذه تعتبر كنز ثمين .. خالص إحتراماتي

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

السلام عليكم دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي ثلاثة معطيات بدالة واحدة Option Explicit ' بسم الله الرحمن الرحيم ' ******************** ' دالـــــــــــــــة ' Kh_Date_Sex_Province ' ( استخراج تاريخ الميلاد او النوع (ذكر - انثى ' او المحافظة من الرقم القومي '============================================== ' MyTest ' اذا كانت = 1 تقوم باستخراج تاريخ الميلاد ' اذا كانت = 2 تقوم باستخراج النوع ' اذا كانت = 3 تقوم باستخراج المحافظة '---------------------------------------------- ' MyProvinces في متغير الجدول ' العمل لم يستكمل بعد ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ ' بنفس الطريقة الرقم اولا ثم "/" ثم اسم المحافظة ' : مثال على ذلك ' "01/القاهرة" '============================================== '----------------------------------------------------------------- Function Kh_Date_Sex_Province(MyNumber As Variant, MyTest As Byte) Dim MyProvinces As Variant Dim r As Integer Dim yy As String Dim ty As String * 1 Dim d As String * 2, m As String * 2, y As String * 2 _ , x As String * 2, xx As String * 2 '============================================== ' يمكنك إضافة المحافظات الاخرى الغير موجودة ' او تعديل الموجود في حالات الخطأ MyProvinces = Array("01/القاهرة", "02/الإسكندرية", "12/الدقهلية", "13/الشرقية" _ , "14/القليوبية", "15/كفر الشيخ", "16/الغربية", "17/المنوفية", "18/البحيرة" _ , "19/الإسماعيلية", "21/الجيزة", "22/بني سويف", "24/المنيا", "25/أسيوط" _ , "26/سوهاج", "27/قنا", "28/أسوان", "29/الأقصر", "33/مطروح") '============================================== Kh_Date_Sex_Province = "" On Error GoTo 1 If Len(Trim(MyNumber)) = 0 Then GoTo 1 End If If Not IsNumeric(MyNumber) Or Len(MyNumber) <> 14 Then Kh_Date_Sex_Province = "Error_MyNumber" GoTo 1 End If If MyTest = 1 Then d = Mid(MyNumber, 6, 2) m = Mid(MyNumber, 4, 2) y = Mid(MyNumber, 2, 2) ty = Left(MyNumber, 1) Select Case ty Case "2": yy = y Case "3": yy = "20" & y Case Else: yy = "" End Select If yy <> "" Then Kh_Date_Sex_Province = DateSerial(yy, m, d) ElseIf MyTest = 2 Then If Left(Right(MyNumber, 2), 1) Mod 2 = 1 Then _ yy = "ذكر" Else yy = "انثى" Kh_Date_Sex_Province = yy ElseIf MyTest = 3 Then x = Mid(MyNumber, 8, 2) For r = LBound(MyProvinces) To UBound(MyProvinces) xx = MyProvinces(r) If x = xx Then Kh_Date_Sex_Province = Right(MyProvinces(r), Len(MyProvinces(r)) - 3) Exit For End If Next End If 1: End Function بالنسبة لمعطيات المحافظات لم تستكمل بعد ويمكنك اضافة المحافظات المتبقية حسب ما شرحت بالكود خبور خير دالة استخلاص تاريخ الميلاد و النوع و المحافظة من الرقم القومي.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام .. من فترة وأنا أريد طرح هذا الموضوع ، ولكني بسبب الزهايمر على ما يبدو فإني قد نسيته تماماً .. وذكرني به الأخ الحبيب والمعلم الكبير عادل حنفي فأحببت أن أشارككم هذا البرنامج الصغير في حجمه الكبير في فائدته البرنامج هو Smart Indenter VBA .. يقوم البرنامج بترتيب أسطر الكود بحيث يسهل قراءة الأكواد ..كنوع من التنظيم تنصيب البرنامج سهل للغاية ومش محتاج شرح ... بعد التنصيب ادخل على محرر الأكواد لديك وفي أي موديول مكتوب اعمل كليك يمين ستجد الأداة منصبة في الأوفيس لديك يمكنك اختيار ترتيب الإجراء الفرعي فقط أو الموديول بالكامل أو جميع الأكواد في المصنف مرة واحدة الأداة تعمل مع نظام 32 بت فقط أما 64 بت فلا تعمل للأسف أرجو أن يكون البرنامج مفيد للجميع حمل البرنامج من هنا

أخي الكريم طلبك غير واضح بعض الشيء المفترض أن تشرح ما هي البيانات المراد ترحيلها إلى المصنف "حساب إجمالي المبيعات" أم أنك تريد الإجمالي فقط ؟؟ لا يوجد أرقام في المصنف "بيانات الإكسيل" يفضل دائماً رضع بعض البيانات الوهمية للعمل عليها ويا حبذا لو أرفقت شكل النتائج المتوقعة لتسهل المساعدة وتتضح المسألة تقبل تحياتي

أخي الغالي ياسر فتحي مشكور على مرورك العطر بالموضوع .. وجزيت خيراً على دعائك الطيب المبارك

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

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

السلام عليكم ورحمة الله وبركاته جرب استخدام الكود التالي : Attribute VB_Name = "HideAccessWindows" Option Compare Database Global Const SW_HIDE = 0 Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form loX = apiShowWindow(hWndAccessApp, nCmdShow) End Function 'وهو فقط لاستدعاء الوحدة النمطية السابقة 'ثالثاً :نفذ الاجراءات التالية على كل نموذج رئيسي في القاعدة '1- في خصائص النموذج تحت التبويب "تنسيق" (Format) حول خاصية "نمط الحدود" (Border style) الى "مربع حوار" (Dialog). '2- في التبويب "الكل" (All) 'حول الخاصية "منبثق" (Pop up) الى نعم (Yes) 'حول الخاصية "مشروط" (Modal) الى نعم (Yes) 'خلف النموذج 'Private Sub Form_Open(Cancel As Integer) 'fSetAccessWindow (SW_HIDE) 'End Sub

ربما كان هذا ما تريد count_in _All salim advenved.zip

إذاً ابدأ في طرح طلباتك واحداً تلو الآخر .. حتى يتم التركيز من قبل الأعضاء في شيء واحد.. تقبل تحياتي

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

السلام عليكم بعد إذنكم إخواني سيتم نقلك إلى آخر خلية في العمود A تفضل جرب المرفق active1.rar

جرب هذا الملف اذا اعجبك انقل الكود اليه مع التعديلات اللزمة count_in _All salim.zip

وعليكم السلام تفضل =DCount("*","[tabel2]","[contact no]=" & [contact no] & " And [Type speech]='خطاب وارد'") او =DCount("*";"[tabel2]";"[contact no]=" & [contact no] & " And [Type speech]='خطاب وارد'")

السلام عليكم ورحمة الله وبركاته الأستاذ طارق ليك الحق تقول up up بس ما فكرتش ليه لحد دلوقتى مفيش ردود ؟! المهم جرب الكود ده ومتنساش ان حماية الملفات قاصرة وأى ناشئ اكسل يدوب لسه بيعرف اكسل يقدر يفقع لك الملف الكود يوضع فى حدث الورقة من خلال هذا الكود تستطيع تعديل البيانات فى النطاقين ("B7:B106,F7:F106") اذا كان التاريخ فى النطاقين ("C7:C106,G7:G106") أكبر أو يساوى تاريخ اليوم واذا كان التاريخ فى النطاقين ("C7:C106,G7:G106") أقل من تاريخ اليوم لن تستطيع التعديل بالا بادخال الرقم السرى الموجود بالكود 123 Private Sub Worksheet_Change(ByVal Target As Range) ' Protect Range from change After specific Date ' By Mokhtar 8/10/2015 Dim pwd As String: pwd = 123 If Not Application.Intersect(Target, Range("B7:B106,F7:F106")) Is Nothing Then If Target.Offset(, 1).Value < CVDate(Date) Then If Application.InputBox("برجاءإدخال كلمةالمرور لتعديل البيانات", "تصريح تعديل بيانات", "***") <> pwd Then Application.EnableEvents = False Application.Undo Application.EnableEvents = True MsgBox "عفواً... ليس لديكم الصلاحية لتعديل البيانات" Else Exit Sub End If End If End If End Sub تحياتى عدم السماح للمستخدم بتعديل ائ بيانات 2 .rar

أخي الحبيب عبد العزيز المقصود التعامل مع العمود F وليس الخلية F6 بذاتها .. من ثم عند تحديد النطاق فإننا نتعامل مع أول صف في المعادلة .. ونثبت العمود فتكون المعادلة بتثبيت العمود F اما رقم الصف فيكون متغير لأننا نريد أن نختبر الشرط في كل صف في نفس العمود أرجو أن أكون قد وفقت في توصيل المعلومة

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

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

ارجو ان يكون هذا هو المطلوب عذرا على التأخير غياب.rar

اخي قلم الأكسيل الملف يعمل بالطريقتين طريقة اخي ياسر واخي رمهان قد يكون لديك مشكلة بالاكسيل معلومة: كانت لدي مشكلة مع الاكسيل ولم استطع حلها الا عندما قمت بعمل يوزر جديد ومسحت اليوزر القديم الحروف المعكوسة.rar

جربت الملف مرة أخرى وكتبت كلمة الصحة وأعطتني النتيجة "ا ث ن و ة" لا أدري ما المشكلة لديك .. يمكنك أن تذهب للتبويب Formulas ثم Calculation Options واختر الأمر Automatic

أخي الكريم ممكن توضح طلبك بشكل أكثر تفصيلاً

تفضل جرب المرفق Copy of 10#3.rar

مجرد فكرة خفيفة لية تلوووووووووووووووووب في المدى خلية خلية وانت ممكن تعمل اللي انتة عاوزة بالفلترة الفكرة بالمرفق Book1.rar

تشكر اخي وائل بعد اذنك اضافة بسيطة Book1 salim.zip

اخى واستاذى محمد فكره رائعه وكود جميل ولكن لنا عتاب معك غيابك يطول لاتحرمنا منك ولى ملاحظه ارجو من حضرتك تداركها بعد ما يتم فتح الملف وتظهر الرساله التى تفيد بتغير التاريخ او انتهاء الصلاحيه جرب فتح الملف مره ثانيه يحدث خطأ انا حليت المشكله دى بالطريقه البسيطه ولكن عايز اعرف طريقة حضرتك فى الحل هتكون ازاى للاستفاده اكثر تقبل تحياتى السلام عليكم ورحمة الله أشكرك جدا على ملاحظتك القيمة فعلا أنا لم أختبر فتح الملف مرة ثانية فقد كتبت الكود وتأكدت من عمله مرة واحدة ولم أفتحه مرة ثانية وعند مراجعته أيضا اكتشف عيب ثاني وهو لم تم الفتح في يوم لاحق لليوم المحدد فكان حل المشكلة بسيط جدا بإضافة اشار < على الكود إليك الكود الجديد فقط اضافة اشارة < On Error GoTo 1 If Sheets("test_my_date").Range("A1") >= DateValue("27/09/2015") Then If Date >= DateValue("27/09/2015") Then MsgBox "تم الكشف عن تغير في تاريخ الجهاز مفكر مالنا كاشفينك -_- " ThisWorkbook.Save Application.Quit Exit Sub End If End If1 If Date >= DateValue("27/09/2015") Then Sheets.Add After:=Sheets(Sheets.Count) ActiveSheet.Name = "test_my_date" Range("a1") = DateValue("27/09/2015") MsgBox "هذا الملف منتهي الصلاحية" ThisWorkbook.Save Application.Quit End If End Sub كما اني بانتطار حلك وشكرا على الملاحظة مرة ثانية بالنسبة للغياب فهو خارج عن ارادتي وكم احب التواجد هنا وفي كل مكان يمكن فيه نشر العلم والفائدة لك كل التحية والاحترام

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

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

اخواني الاكارم >> السلام عليكم وبعد الموضوع قديم وجديد بنفس الوقت >> فهو قديم قدم اقامتي في هذه المنتديات ، فقد طرحته من سنين في منتدى الفريق العربي الفقيد >> وجديد انه لا يوجدعلى الساحات العربية ولا الاجنبية مثل هذا العمل على اكسس المطلوب / المحاولة بعمل تطبيق مشابه لا يوجد شروط >> الاحداث بلا عدد >> والاكواد مفتوحة اكتبوا من الخليج الى المحيط المدة المحددة>> مفتوحة حتى توقف التفاعل الفئة المستهدفة >> جميع الاعضاء وفي مقدمتهم الخبراء ملحوظة >> يجب اضافة المكتبة المصاحبة YsVedPic.OCX الى النظام وتسجيلها myPic.rar

العزيز يحيـــــــــــــــــــــــاوي : هذا الكود - تجميد وتقسيم الشاشة - من اعمال اخونا الاستاذ " عمر الحسيني " بتصرف يحياوي وفقك الله ياسر الحافظ " ابو الحارث " يحياوي تجميد و تقسيم الشاشة2.rar

هذا كود يحذف القيم الأصغر أو التواريخ الأحدث مع حذف الصف كله لكنه يقوم بذلك في الخلايا المرتبة فوق بعضها مش عارف أوضح تماماً لكن التجربة في الملف المرفق أفضل حذف القيم الأصغر أو التواريخ الأقدم.rar

السلام عليكم إستخدم معادلة =ROUNDUP(A1,0) بفرض أن الرقم الذي تريد تحويله موجود في الخلية A1