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

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

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

السلام عليكم ورحمة الله وبركاته نبدأ بعون الله في شرح شيء جديد في عالم البرمجة ، وهو القاموس 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

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

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

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

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

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

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

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

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

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

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

اخي aburajai وبعد اذن اخي الحبيب ياسر خليل أبو البراء جرب المرفق سيكون القيد كالتالي Private Sub Workbook_Open() Sheets("sheet3").Activate ActiveSheet.Range("H6").Select End Sub active.rar

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

السلام عليكم ورحمة الله وبركاته الدرس الثامن 8-Loop الحلقات التكراريه وسوف نتناول فى هذه الدرس الاتى لماذا نستخدم الحلقات التكراريه انواع الحلقات التكراريه الخروج من الحلقه التكراريه كيفية استخدام اكثر من حلقه داخل الكود ......................................................................... لماذا نستخدم الحلقات التكراريه انا شخصيا بعتبر الحلقات التكراريه واحده من اهم المواضيع التى يجب معرفتها حينما يتم الدخول الى عالم vba يتم استخدام الحلقات التكراريه لتنفيذ اكثر من امر فى وقت واحد مما يوفر الوقت ولتوضيح ذلك راجع المثال الاتى نفترض اننا لدينا مجموعه من الارقام مثلا 7 ارقام (1-2-3-4-5-6-7) ونريد ادخال هذه الارقم فى السطر الثامن بداية من العمود الخامس اى العمود e فكيف سنقوم بعمل ذلك طبعا الى معندوش فكره عن كيفية استخدام الحلقات التكراريه هيستخدم الكود الاتى Sub enterdata() [e8] = "1" [f8] = "2" [g8] = "3" [h8] = "4" [i8] = "5" [j8] = "6" [k8] = "7" End Sub اى سيقوم بالاشاره الى كل خليه على حده واعطاء كل خليه قيمتها كما هو متضح من الصوره وبالتالى بعد كتابة هذه الكود وتخصيص زر لتنفيذه او بالوقوف داخل الكود بالماوس ثم الضغط على f5 سوف يتم ملئ الخلايا بالبيانات كما فى الصوره دعونا الان نتطرق الى كيفيه تنفيذ ذلك بالحلقات التكراريه انواع الحلقات التكراريه 1- FOR 2- WHILE 3- DO ................................................................................................................................................................................................................................................................ الحلقه الاولى for …next هذه الحلقه تبدأ بكلمة FOR وتنتهى بكلمة NEXT وفيما بين الكلميتن هو ما سوف يتم تنفيذه للتوضيح اكتر For بداية الحلقه = اسم الحلقه To طريقه تنفيذ الحلقه] نهايةالحلقه] [ماسيتم تنفيذه داخل الحلقه] [Exit For] الخروج من الحلقه Next استكمال الحلقه حت النهاية وهنا يجب ان نشير الى ان اى حلقه تكراريه لابد ان يكون لها اسم يعبر عنها وليكن مثلا H ثم يجب ان يكون لها بدايه ولها نهايه وليكن ستبدأ من 1 وتنتهى فى 10 ثم سيكون هناك ما ينفذ داخل الحلقه والمقصود بطريقة تنفيذ الحلقه اى هل سيتم تنفيذها خطوه بخطوه وهذا هو الشائع فى الاستخدام ام كل خطويتن ام كل ثلاث خطوات وهكذا ولتطبيق ذلك سنتعرف على كيفية استخدام الحلقه for فى ادخال البيانات فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 26 بداية من العمود 8 كيف سنقوم بعمل ذلك 1-نعطى الحلقه اسم معين FOR H H 2-نحدد البدايه 8 ونحدد النهاية 11 FOR H =8 TO 11 لاحظ ان عدد الحلقات هنا 4 عباره عن 8و9و10و111 3-ماسيتم تنفيذه Cells(26, h) = h - 7 4-استكمال الحلقه NEXT وبالتالى سيكون شكل الكود كالاتى Sub enterdata_for() For h = 8 To 11 ' h----- متغير تم تعريه على انه يبدأ من 8 وينتهى عند 11 ' اى ان عدد حلقاته هى 4 عباره عن 8ثم9ثم10ثم11 Cells(26, h) = h - 7 ' هنا يتم تنفيذ الكود ' هنا نقول ان الخليه التى تقع فى السطر26 وفى العمود من8الى11 ' مطروحا منه 7 ارقام ليصبح قيمة المتغير تساوى1hتساوى قيمة المتغير ' Cells(26, H)--- الرقم26هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(26, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ على الاعمده من 8الى11 لانها تساوى قيمة المتغير ' h-7 يبدأ من الرقم8وينتهى عند الرقم11 فحينما ينم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تبدأ من الرقم1وتنتهى عند الرقم4 'وبذلك يكون تنفيذ الكود كالاتى ' الخليه فى السطر26وفى العمود5تساوى الرقم1ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم2ثم ' الخليه فى السطر26وفى العمود6تساوى الرقم3ثم ' وهكذا حت نصل الى اخر الحلقه التكراريه اى العمود11 Next ' hتكرار عمل الكود حتى نهاية المتغير ' next---- forاقفال الحلقه التكراريه End Sub ويكون ناتج الكود بهذا الشكل اما اذا اردنا تنفيذ الكود على الخلايا بشكل عمودى بدلا من الخلايا الافقيه بمعنى لو اننا اردنا مثلا تنفيذ نفس الكود على الخلايا من h23 الى h26 اى فى الخلايا h23 و h24 و h25 و h26 كيف سيكون شكل الكود الكود هيكون نفس الكود السابق ولكن ما سيختلف هو اننا سوف نعيد تغير قيمة المتغير h الخاص بالحلقه التكراريه ليصبح من 23 الى 26 ثم نقوم بتغير موضع المتغير h الخاص بالحلقه التكراريه من الصف الى العمود للتوضيح اكثر الفكره هكلها محصوره فى السطرين دول For h = 8 To 11 هنا طبعا قيمة المتغير h الخاص بالحلقه التكراريه من 8 الى 11 احنا عايزين نخليه يبقى من 23 الى 26 يبقى هيكون بالشكل ده For h = 23 To 26 وكمان فى السطر ده Cells(26, h) = h - 7 وطبعا احنا قولنا ان الجزئيه دى Cells(26 تعنى ان الكود سوف ينفذ على السطر 26 والجزئيه دى Cells( , h) تعنى انه هينفذ على العمود h وطبعا h احنا معرفينه على انه من8 الى 11 اى انه سينفذ على العمود 8 ثم العمود 9 ثم العمود10 ثم العمود11 .................................................................................................... طب حنا عايزين ننفذ الكود على العمود h اى العمود رقم 8 يبقى سطر الكود هيكون بالشكل ده Cells( , 8) وعلى السطور من 23 الى 26 وبما اننا عرفنا h على انه من 23 الى 26 يبقى سطر الكود هيصبح بالشكل ده Cells(h, ) وفى النهاية هنلاقى ان سطر الكود بالكامل بالشكل ده Cells(h,8 ) اى ان الكود سينفذ على السطور h الى احنا عرفناها على انها من 23 الى 26 وعلى العمود رقم 8 وبعد كده تأتى الجزئيه دى = h - 7 ولاننا كنا معرفين h يبدأ من الرقم 8 فطرحنا من h الرقم 7 للحصول على الرقم 1 الى هو اول رقم احنا عايزين ندخله فلا او خليه وبما اننا لسه بردو عايزين نخلى الرقم 1 هو اول رقم يتم ادخاله ولكننا قمنا بتغير قيمة المتغير h لتصبح من 23 وللحصول على الرقم 1 يبقى لابد اننا نطرح من المتغير h ما يعطينا الرقم 1 وبالتالى سنجد سطر الكود هيكون كده = h - 22 وفى النهاية سيكون شكل الكود كده Sub enterdata_for1() Dim h As Integer For h = 23 To 26 Cells(h, 8) = h - 22 Next End Sub ويكون ناتج الكود بهذا الشكل الحلقه الثانيه While سوف نتعرف على كيفيه استخدام الحلقه التكراريه While...Wend هذه الحلقه تبدأ بكلمة While وتنتهى بكلمة Wend وفيما بين الكلميتن هو ما سوف يتم تنفيذه للتوضيح اكتر While [ الشرط ] ما يتم تنفيذه Wend نهاية الحلقه فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 38 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterwhileWend() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه Cells(38, h) = h - 7 ' Cells(38, H)--- الرقم38هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(38, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Wend '-------'نهاية الحلقه While End Sub ويكون ناتج الكود بهذا الشكل الحلقه الثالثه Do تنقسم الى ثلاثة انواع النوع الاول Do While Loop فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 57 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDoWhile() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه Cells(57, h) = h - 7 ' Cells(57, H)--- الرقم57هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(57, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop '-------'نهاية الحلقه Do While End Sub ويكون ناتج الكود بهذا الشكل النوع الثانى Do Loop While فلو اننا نريد ادخال الارقام من1 الى 4 فى السطر 67 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDo() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do Cells(67, h) = h - 7 ' Cells(67, H)--- الرقم67هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(67, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop While h <= 11 ' هنا نقول ان الحلقه التكراريه تكون اقل من الرقم11او تساويه '-------'نهاية الحلقه Do End Sub ويكون ناتج الكود بهذا الشكل النوع الثالث Do Until Loop فلو اننا نريد ادخال الارقام من 1 الى 4 فى السطر 77 بداية من العمود 8 كيف سيكون شكل الكود Sub EnterDoUntil() Dim h As Integer ' H--- متغير تم تعريفه على انه رقم صحيح h = 8 ' متغير تم تعريفه على انه يساوى الرقم8----- Do Until h > 11 ' هنا نقول ان الحلقه التكراريه سوف تنفذ حتى الرقم11 Cells(77, h) = h - 7 ' Cells(77, H)--- الرقم77هنا يدل على رقم السطر الذى سينفذ فيه الكود ' Cells(77, H)--- عباره عن العمود الذى سينفذ فيه الكود وبذلك يتضحh ' hلنا ان الكود سوف ينفذ بديةمن العمود8 لانها تساوى قيمة المتغير ' h-7 يساوى الرقم8 فحينما يتم طرحhبما ان المتغير ' الرقم7 من المتغير بذلك تصبح قيمة المتغير تساوى الرقم1 h = h + 1 'h = h + 1 هنا نقول انه يتم زياده قيمة المتغير بقيمة1صحيح مع كل ' حلقه تكراريه حتى نصل الى الشرط وهو ان يكون اقل من او يساوى11 Loop '-------'نهاية الحلقه Do Until End Sub ويكون ناتج الكود بهذا الشكل الخروج من الحلقه التكراريه نتعرف هنا على كيفيه الخروج من الحلقه التكراريه مثال لو اننا لدينا اسماء فى الخلايا من a80:a85 ونريد فى حالة تطابق الاسم الاسم الموجود فى الخليه b80 مع الاسماء الموجود فى النطاق يتم كتابة الرقم 1 فى الخلايا من c80:c85 وفى حالة فراغ الخليه يتم الخروج من الحلقه التكراريه كيف سيتم تنفيذ ذلك بالكود لاحظ كما فى الصوره ان الخلايا الموجوده فى العمود c فارغه جرب تنفيذ الكود الاتى Sub hima() Dim h As Integer For h = 80 To 85 If Cells(h, 1) = [b80] Then Cells(h, 3) = 1 End If Next End Sub شاهد النتيجه بعد تنفيذ الكود ستلاحظ انه تم ادخال الرقم فى كل خلايا العمود c التى تقابلها فى العمود a الاسم a اما اذا قمنا باضافة exit for الى الكود هكذا Sub hima() Dim h As Integer For h = 80 To 85 If Cells(h, 1) <> [b80] Then Exit For End If If Cells(h, 1) = [b80] Then Cells(h, 3) = 1 End If Next End Sub لاحظ هنا انه تم اضافة هذه الاسطر الى الكود If Cells(h, 1) <> [b80] Then Exit For End If وهنا نقول انه فى حالة ان الخلايا فى العمود الاول لاتساوى الخليه b80 يتم الخروج من الحلقه التكراريه ولا يتم تنفيذ شئ اخر وهنا نلاحظ الاتى كما فى الصوره ان الخليه a80 بها الاسم a وان الخليه a81 بها الاسم b لذلك فان الكود خلال تنفيذه تم اكتشاف ان لااسم فى الخليه الاولى a80 مطابق فتم اعطاء الخليه المقابله لها فى العمود c الرقم1 ثم حينما تم الوصول الى الخليه الثانيه a81 تم اكتشاف انها غير مطابقه فتم الانتقال الى السطر exit for وبذلك تم الخروج من الكود ولم يتم تنفيذ شئ اخر نجد ان exit for تستخدم للخروج من الحلقه التكراريه For Next نجد ان exit do تستخدم للخروج من الحلقه التكراريه do نجد ان exit Sub تستخدم للخروج من الكود نهائيا مثال تلوين الخلايا من g95:k95 باللون الاحمر Sub color_loop() Dim h As Integer For h = 7 To 11 Cells(95, h).Interior.Color = RGB(255, 0, 0) ' red Next End Sub استخدام اكثر من حلقه فى كود واحد مثال ماذا لو اردنا تلوين الخلايا من g102:k102 بالوان مختلفه بحيث تأخذ الخليه ذات الزوجى اللون الاسمر Sub color_loop1() Dim h As Integer For h = 7 To 11 If h Mod 2 = 0 Then Cells(102, h).Interior.Color = RGB(0, 0, 0) ' red Else Cells(102, h).Interior.Color = RGB(200, 0, 0) ' blak End If Next End Sub ماذا لو اردنا ادخال الاسم فردى فى السطور الفرديه والاسم زوجى فى السطور الزوجيه من g109:k114 بحيث يأخذ السطر الفردى الاسم فردى والسطر الزوجى الاسم زوجى Sub color_loop2() Dim h As Integer Dim hh As Integer For h = 1 To 5 For hh = 7 To 11 If h Mod 2 = 0 Then Cells(h + 108, hh) = "زوجى" Else Cells(h + 108, hh) = "فردى" End If Next Next End Sub اتمنى ان يكون الدرس مفيدا مرفق شيت اكسيل به التطبيقات learnvba.rar تقبلوا تحياتى learnvba.rar

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

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

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

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

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

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

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

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