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

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

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

السلام عليكم ورحمة الله وبركاته نبدأ بعون الله في شرح شيء جديد في عالم البرمجة ، وهو القاموس 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% .. مواضيع كهذه تعتبر كنز ثمين .. خالص إحتراماتي

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

السلام عليكم دالة استخراج تاريخ الميلاد او النوع او المحافظة من الرقم القومي ثلاثة معطيات بدالة واحدة 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

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

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

جرب الكود بهذا الشكل Sub PrintIt() Application.ScreenUpdating = False With Sheets("Sheet1") .Visible = True .Activate .PrintOut .Visible = False End With Application.ScreenUpdating = True End Sub

أخي الكريم أبو أحمد أهلاً بك في المنتدى ونورت بين إخوانك يرجى مراجعة رابط التوجيهات لمعرفة كيفية التعامل بشكل أفضل مع المنتدى (خصوصاً التوجيه الثالث عشر) من هنا

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

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

تم التعديل تفضل جرب المرفق الجديد البرنامج3.rar

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

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

السلام عليكم ورحمة الله وبركاته الأستاذ طارق ليك الحق تقول 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

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

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

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

ببساطة حدد النطاق A1:H8 ثم اذهب للتبويب Home ثم Conditional Formatting ثم اختر New Rule ثم من النافذة اختر آخر خيار المسمى Use a formula to determine which cells to format ثم ضع المعادلة التالية في المستطيل بالأسفل =$F1=0

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

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

بارك الله فيك استاذ جعفر

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

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

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

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

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

السلام عليكم =========== اخوانى واحبائى واحب الناس الى قلبى ( اعضاء - مشرفين - مسئولى )ممنتدى اوفسينا كم تعلمت منكم وكم زادنى شرف الردود لكم وعليكم والان موعدى معكم لرد جميلكم الثقيل على كتفى خفيف على قلبى الى كل من علمنى حرفا فى هذا المنتدى وسيعلنى اهديكم هذا البرنامج داعيا الله ان يكون على المستوى اللائق واعطائى ولو درجة النجاح والنجاح فقط ميزات البرنامج ============== 1) يصلح للصفين معا فهو يتعامل مع صيغتى الاناث والذكور ( طالبات - وطلبة ) بمجرد اختيار بنين او بنات فى صفحة البيانات فمعادلاته مجهزة لذلك . 2) يتعامل مع الصفين الاول والثانى عند اختيار الصف فى صفحة البيانات فالمعادلات ايضا مجهزة لذلك 3)البرنامج يجمع فى طياته كل افكار الكنترولات السابقة فقط مع اضافة توزيع اللجان وارقام الجلوس لاى صف من الصفين دون التدخل لكتابة الصف او الجنس . 4)صفحة السرى ( لها رقم سرى لعدم الاطلاع من قبل اعضاء الكنترول والسرى هو 12) لعالمنا الجليل خبور 5)فى صفحة ف د 1 يوجد زر للكتشنة وفك الكتشنة وكانت الفكرة للاستاذ ايسم بارك الله فيه 6) يوجد فى نفس الصفحة زر للتقريب بما يتناسب مع قوانين الرفع وهو اختيارى والكود للاستاذ الكبير ابو تامر . 7)شهادة الفصل الدراسى الاول صفحة واحدة فقط وهى فقط كعملية جمالية تعمدت الا يكون الصفحة بها اكثر من شهادة وذلك لتجنب القص وغيرة ( رزمة الورق تقص فى المطبعة كما هى الى نصفين وتوضع فى الطابعة كما هى ) 8)ما اعتبره اهم ميزة هو شهادة الفصل الدراسى الثانى تكون بالدوائر . 9) ترحيل الشيت الى ناجح ودور ثانى للطباعة وايضا بالدوائر 10) لا املك اى كود فى هذا البرنامج الا كود التجهيز فقط اما باقى الاكواد قكلها موجودة فى المنتدى 11) اشكر كل من ساهم بفكرة واخص وسامحونى بالترتيب الاستاذ مجاهد اعادة الله لنا سالما العالم الجليل خبور خير الاستاذ الفذ ابو تامر اخى وصديقى ايسم واترككم مع البرنامج فى رعاية الله وفى انتظار تعليقاتكم

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