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

السلام عليكم ورحمة الله وبركاته إخواني الأحباب سبق أن قمنا بكسر حماية محرر الأكواد بدون برامج .. الآن مع كسر حماية أوراق العمل بالاستعانة ببرنامج صغير الحجم اسمه XML Marker وهو برنامج للتعديل على ملفات الـ XML وهو مرفق في الموضوع ... أترككم مع الفيديو ..عسى أن تستفيدوا منه إن شاء الله (ومتنسوش اللايكات !!) تقبلوا تحيات أخوكم أبو البراء xmlmarker_2_2_setup.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام .. قد يكون موضوع الكسر موضوع شائك وفيه خلاف ، ولكن ربما يكون مفيد لصاحب العمل نفسه ، حيث أنه معرض لنسيان الباسورد الذي تم وضعه على محرر الأكواد .. الموضوع مميز لأنه يقوم بكسر الحماية بدون برامج على الإطلاق ..وبدون AddIns وبدون الاستعانة بأية برامج مجانية أو مدفوعة !! كسر محرر الأكواد بالأكواد نفسها (قنبلة الموسم) وعلى رأي المثل : علمته رمي السهام فلما اشتد ساعده رماني .. الكود قليل الأصل !! محفظش الجميل للبيئة اللي هو منها ، لأنه كسر بيئة محرر الأكواد !!! Sub HackVBA() Open "C:\Users\Future\Desktop\Test.xls" For Binary As #1 Put #1, 1, Replace(Input(LOF(1), 1), "DPB=", "DPX=", , 1) Close Workbooks.Open "C:\Users\Future\Desktop\Test.xls" End Sub المطلوب فقط أن تغير مسار الملف المراد كسره داخل الكود ، والمسار يوضع بين أقواس تنصيص .. أترككم مع الفيديو عله ينال إعجابكم وتستفيدوا منه إن شاء المولى .. ولا تنسونا من اللايكات على اليوتيوب !!!!! ....أكرر اللايكات على اليوتيوب ..فضلاً لا أمراً تقبلوا تحيات أخوكم أبو البراء

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم كود متميز جداً .. كود في منتهى الروعة .. إن شاء الله تستفيدوا منه أقصى استفادة .. الكثير منا يبحث عن موضوع فصل الناجحين والراسبين .. ها أنا أقدم لك على طبق من كود : الكود الذهبي الذي سيقوم بذلك بمنتهى السهولة واليسر .. هذا هو الشكل العام للكود Sub SplitFilteredData() 'الإعلان عن المتغيرات Dim MySheet As Worksheet Dim MyRange As Range Dim UList As Collection Dim UListValue As Variant Dim I As Long 'تخصيص ورقة العمل النشطة Set MySheet = ActiveSheet 'إذا لم تحتوي ورقة العمل على فلترة يتم الخروج من الإجراء الفرعي If MySheet.AutoFilterMode = False Then Exit Sub End If 'حدد العمود الذي يحتوي على البيانات المراد عمل تصفية لها Set MyRange = Range(MySheet.AutoFilter.Range.Columns(5).Address) 'إنشاء كائن تجميعي Set UList = New Collection 'وضع قيم في الكائن التجميعي بالقيم الفريدة أي الغير مكررة فقط On Error Resume Next For I = 2 To MyRange.Rows.Count UList.Add MyRange.Cells(I, 1), CStr(MyRange.Cells(I, 1)) Next I On Error GoTo 0 'حلقة تكرارية للقيم الموجودة داخل الكائن التجميعي For Each UListValue In UList 'حذف أية أوراق عمل تم إنشاءها من قبل On Error Resume Next Application.DisplayAlerts = False Sheets(CStr(UListValue)).Delete Application.DisplayAlerts = True On Error GoTo 0 'عمل تصفية لمطابقة القيمة الحالية MyRange.AutoFilter Field:=5, Criteria1:=UListValue 'نسخ النطاق الذي تم تصفيته إلى ورقة عمل جديدة MySheet.AutoFilter.Range.Copy Worksheets.Add.Paste ActiveSheet.Name = Left(UListValue, 30) Cells.EntireColumn.AutoFit 'إعادة الحلقة التكرارية مع قيمة أخرى Next UListValue 'الذهاب للصفحة التي تحتوي على البيانات وإزالة الفلترة MySheet.AutoFilter.ShowAllData MySheet.Select End Sub في الفيديو شرح لكيفية استخدام الكود .. ومرفق في الموضوع الملف الذي تم الشرح عليه إليكم رابط الفيديو لا تنسونا من صالح دعائكم ، ولا تنسوا اللايكات في اليوتيوب ... تقبلوا تحيات أخوكم أبو البراء Split Filtered Data VBA.rar Split Filtered Data VBA V2.rar

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

عموما كويس إنك مش بعيد .إحنا طلعنا جيراااان (الإكسيل والأكسس جيران ..) وفقك الله لما يجب ويرضى .. تقبل تحياتي

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

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

الأخ الحبيب والأستاذ الكبير أبو محمد عباس مشكور على مرورك العطر ومفتقدين تواجدك الدائم معنا ..مشغول عننا بمين ؟؟!! الأخ الكريم سامي مشكور على مرورك الكريم بارك الله فيك

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

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

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

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

وعليكم السلام ورحمة الله جرب هذا الكود في حدث عند تحميل النموذج If Me.ÇáÊÇÑíÎ.Value >= DatNow.Value Then save.Enabled = True Else save.Enabled = False End If test.rar

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

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

باستعمال الدالة OR مع إضافة الشرط نفسه لليوم الآخر.... أي أن تكون المعادلة على الشكل التالي : =IF(OR(TEXT($C15,"[$-809]ddd;@")="Fri",TEXT($C15,"[$-809]ddd;@")="Sat"),"0:00","17:00") بن علية

استاذى واخى الحبيب / حسام عيسى (الصقر) ربنا يبارك فيك فانت تسعدنى دائما بكلامك الطيب فى حقى واسال الله ان يوفقنى ويعننى على استكمال هذه الفيديوهات تقبل تحياتى وشكرى

وعليكم السلام اخي 1. ذكرتني بأيام زمان ، زمان لما القرص الصلب Harddisk حجمه ما كان يتجاوز 512MB ، وانا اشتريت 3 قطع من SCSI قرص بحجم 9GB من شركة Micropolis لمونتاج الفيديو على VideoToaster ، زمان وذكرتني بأول كمبيوتر اشتريته ، حيث طلبت حجم القرص يكون 20MB ، ولما البائع تأخر يومين في توصيل الكمبيوتر ، غير لي القرص من 20MB الى 30MB ، وحينها قلت في نفسي ماذا سأفعل بهذا الحجم 2. نعم ممكن تستخدم اي برنامج خارجي يسمح لك بالتحكم فيه عن بُعد عن طريق Command line او ActiveX ، قد لا يكون NAPS2 هو الافضل ، لأني كما قلت سابقا: فبحثي السريع اوصلني الى هذا البرنامج ، والسبب الذي اخترته دون باقي البرامج هو إمكانية التحكم به عن طريق Command line ، وعلى فكرة ، يوجد برنامج مجاني يستخدم ActiveX ويمكن استخدامه للأكسس على هذا الرابط: http://access.bukrek.net/ وهناك مثال في الأكسس http://access.bukrek.net/samples وحسب بحثي السريع ، فان برنامج WinScan2PDF لا يمكن السيطرة عليه بالطريقتين اعلاه (بالاضافة أنه يحتفظ بالصور في مجلد مؤقت ولا يحذفها!!). جعفر

السلام عليكم شكرا اخي EMembers-1 على المساعدة وجزاك الله خيرا ولكن لدي سؤال اخر ان تكرمن علي بذلك كيف استطيع تحديد ايام العطلة يومين مثلا الخميس والجمعة ولك جزيل الشكر جدول دوام يومين.rar

اخى kmb محاوله جيده وعمل ممتاز ومن تقدم الى تقدم ..................................... واضح ان الدروس كانت مثمره ................... تقبل تحياتى

بارك الله فيك اخي الكريم وجزاك الله خير الجزاء وجعله في موازين اعمالك ان شاء الله

استاذ ياسر شرح وافى و ممتاز جزاك الله كل خير و جعلة فى ميزان حسناتك

السلام عليكم ورحمة الله تفضل اخي حسب ماطلبت 2015.111111.rar

جزاك الله خيرا ورحم الله والديك تم المراد

تفضل في الاكسس VBA Help ، ابحث عن Timer وسترى هذا المثال: Dim PauseTime, Start PauseTime = 5 ' Set duration in seconds Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop جعفر

السلام عليكم اتفضل استاذ صديق حل ب 3 طرق معادلة صفيف / advanced filter / pivottable تحياتى جلب البيانات.rar

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

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

أخي رمهان انا كنت اظن اني بكتب كلمتين واشرد ، بس الظاهر انك صدتني انا اميل لإستخدام طرف ثالث ، وبحثت شوي زيادة ، وتوصلت الى برنامج آخر ، وجربته واشتغل تمام البرنامج اسمه NAPS2 من http://sourceforge.net/projects/naps2/ مفتوح المصدر http://sourceforge.net/p/naps2/code/ci/master/tree/ اوامر Commandline: http://sourceforge.net/p/naps2/wiki/Command%20Line%20Usage/ فيمكنك ان تتوصل الى طرف خيط اي api يستخدم (ما اعرف اي لغة مكتوب بها البرنامج)، فيه Commandline وجربته ، والنتيجة جميلة 1. نصب البرنامج ، 2. اعمل Profile لجميع اجهزة السكانر عندك ، بس اعطي كل جهاز اسم خاص بيه (انا سميت جهازي HP8500) ، 3. استخدم Commandline التالي: "C:\Program Files\NAPS2\naps2.console" -o "F:\scanned receipt.pdf" -p HP8500 وكله تمام ، وبهذه البساطة جعفر

السلام عليكم ورحمة الله وبركاته اسمحوا لي ان اعرض فكرتي لكل جهاز طريقته الخاصة لمخاطبة الكمبيوتر بالكود ، وهذا يجعل العمل على كل الاجهزة عملية صعبة للغاية لذا ، اذا كان هناك برنامج محترف وسيط (مثل ما ذكراخي soft.Sample مثلا) ، فهو سيقوم بالعمل القذر (يعني ربط الجهاز بالكمبيوتر وDrivers و... ) ، والمطلوب من هذا البرنامج الوسيط ان يكون في امكانية التحكم به من برنامج الاكسس (وإلا فاننا نستطيع العمل مباشرة عن طريق برنامج الجهاز). برنامج IrfanView بالاضافة الى Plug-ins التابعة له: http://www.irfanview.com/ من البرامج التي لا استطيع ان استغنى عنها ، فاول ما يكون عندي كمبيوتر جديد ، فعلى طول انزل وانصب هذا البرنامج المجاني الأكثر من رائع احد الخصائص التي في البرنامج ، انك ممكن تتحكم فيه عن طريق CommandLine ، وفيه العديد من الاوامر ، وهذا الشئ مهم اذا كنا نريد استعماله مع الاكسس. البرنامج كذلك يستطيع التعرف على جميع اجهزة السكانر المرتبطة بالكمبيوتر: فلما تريد ان تقوم بعملية مسح مستندات من الاسكانر ، فما عليك إلا ان تقوم باختيار الماسح من القائمة (مرة واحدة فقط) ، وبعدها تستخدم هذا الامر من الكود في VBA عن طريق الامر Shell او ShellWait: "c:\program files\irfanview\i_view32.exe" /batchscan=(scanfile,1,1,2,0,c:\temp,tif,1) /scanhidden "c:\program files\irfanview\i_view32.exe" /multipdf=(c:\temp\test.pdf,c:\temp\scanfile01.tif) /killmesoftly والذي يقوم بمسح المستندات وحفظها بصيغة tif ، ويقوم السطر التالي بتحويل المستند الى pdf. وبما ان الكود في VBA ، فيمكنك التحكم في اسم المجلد اسم الملف وترقيمه و.... جعفر

الحلقة الرابعة عشر ***************** السلام عليكم ورحمة الله وبركاته وحشتكم !! أكيد لا .. لأني لو وحشتكم كنتو فتحتوا الباب وسألتوا عليا .. عموما إنتو وحشتوني ، وعشان وحشتوني هاقدم لكم حلقة جديدة يمكن تفتكروني. النهاردة هتكلم عن حاجة ناس كتير شرحوها ، وشرحوها بشكل ممتاز ، ودا خلاني مش عارف أشرح إزاي ، لأن اللي شرحوها وفوا شرحها صراحة .. هنتكلم عن الحلقات (بس مش حلقات افتح الباب) الحلقات اللي هنتكلم عنها الحلقات التكرارية ، ومن اسمها هي عبارة عن حلقات بتتكرر (إضافة عظيمة!) اسمها بالإنجليزي Loops ودي مهمة جداً في عالم الأكواد ، محدش يقدر يستغنى عنها تقريباً .. نفترض إني دخلت الفصل (بما إني معلم) ولسه دي أول مرة أتعرف على الطلبة اللي في الفصل ..يا ترى أنا عندي استعداد أخلى طالب طالب يقوم وأنا أقوله قول اسمك والطالب اللي بعديه قول اسمك .. أعتقد إن ريقي هينشف ودماغي هتصدع ودا طبعا مش يرضيكم (مش كدا ولا ايه) ..أنا من النوع الكسول فكل اللي هعمله هعمل تكرار من أول طالب في الفصل لآخر طالب ، وأعطي الأمر مرة واحدة .. من أول طالب إلى آخر طالب قووووول اسمك يا حبيبي الطالب التالي هو دا شكل الحلقة التكرارية .. نبرمجها بلغة الـ VBA ... هنقول إن الفصل فيه 60 طالب (معلش دا واقع الفصول في مصر) .. نقطة مهمة مننساش إن الطالب متغير مش ثابت ، فنرمز للطالب المتغير بالرمز X مثلاً ... Sub Loops() Dim X As Long For X = 1 To 60 'Say your name Next X End Sub طبعاً الكود دا شوية له علاقة بالبرمجة وشوية هتش .. ايه اللي هنعمله ..زي ما اتعودنا (دايما) إننا نعرف المتغير .. ونركز في السطر الثاني بدأ بكلمة For متبوعة باسم المتغير اللي هو X وبعدين علامة يساوي عشان نحدد قيمة X المتغيرة (أو الطالب المتغير) وهنا القيمة ليها بداية وليها نهاية (كل شيء له بداية ونهاية) وبيفصل بين البداية والنهاية حرف الجر To وفي آخر الحلقة التكرارية جملة Next X وممكن نقول Next ونسكت ، ومحرر الأكواد هيفهم لوحده .. بس أنا تقليدي شويتين فخلينا نكتب المتغير ، عشان الكود ممكن يكون فيه أكتر من حلقة تكرارية .. الجزء المهم هو الجزء اللي بين السطرين ، وهو دا الأمر المطلوب تكراره ، السطر اللي هنا مجرد تعليق وهتش وملوش علاقة بالبرمجة .. بس حبيت أقرب لكم الفكرة بأسلوب جديد.. كدا لما أنفذ الكود اللي فات ، كل اللي عملته إني أعطيت الأمر مرة واحدة وبس (وأنا حاطط رجل على رجل ... الدورة تلف على طالب طالب ، ويقول اسمه ، ولما يخلص ، الدورة تنتقل للطالب اللي بعديه وهكذا إلى أن ينتهي الطلاب ، ولما الـ 60 طالب يخلصوا ..يتم إيقاف تنفيذ الكود... ناخد أول مثال بجد عشان نقدر نتعلم إزاي نستفيد من الحلقات التكرارية :: لنفترض أننا عايزين نرقم النطاق A1:A10 بالأرقام من 1 إلى 10يعني الخلية A1 = 1 والخلية A2=2 وهكذا ..طبعا الموضوع بسيط جدا Sub NumberRange() Range("A1").Value = 1 Range("A2").Value = 2 Range("A3").Value = 3 Range("A4").Value = 4 Range("A5").Value = 5 Range("A6").Value = 6 Range("A7").Value = 7 Range("A8").Value = 8 Range("A9").Value = 9 Range("A10").Value = 10 End Sub كود في منتهى الروعة .. شايف حسام بيضحك ويقولي عايزك ترقم النطاق من A1:A100 (وابتسم ابتسامة فيها شماته !!) نفكر شوية .. بقول نفكر شوية (بلاش تكمل الحلقة غير لما تبص في الكود وتفكر شوية .. فكر شوية واكسب التوفير في الوقت والجهد) ايه المشترك في أسطر الكود .. وايه المختلف .. المتشابه في كل الأسطر Range("A ").Value = والمختلف هو الرقم بعد حرف الـ A ، والقيمة اللي بعد علامة يساوي .. في السطر الأول الرقم اللي بعد حرف الـ A هو 1 ، والقيمة بعد علامة يساوي بردو 1 ، ونفس الكلام مع السطر رقم 2 ، ورقم 3 وهكذا يبقا أول حاجة تفكر فيها إنك المختلف أو المتغير أو الشيء الغير ثابت تضعه في متغير ، ودا لأنه مش ثابت ومتغير .. فنضع متغير باسم X مثلاً ونعمل حلقة تكرارية من 1 إلى 10 (دي القيم اللي هيحملها المتغير) Sub NumberRange() Dim X As Long For X = 1 To 10 Range("A" & X).Value = X Next X End Sub نفس الكود اللي شرحناه من شوية ، الاختلاف في السطر اللي بين سطري التكرار .. الحلقة هتدور 10 مرات ، وفي كل مرة المتغير X بيحمل قيمة مختلفة (نرررررركز في الجزئية اللي جاية لأنها مهمة جداً جداً ) مش هنفذ الكود مرة واحدة .. سنقوم بعملية التنفيذ واحدة واحدة ، اللي مستعجل يروح ينفذ الكود مرة واحدة ، واللي مش مستعجل أنا معاه ..عشان يعرف حاجة مش هيعرفها الأخ المستعجل ... ضع مؤشر الماوس في أي مكان في الكود .. جميل >> اضغط F8 من لوحة المفاتيح ، وجمد قلبك وقول يا رب .. لاحظت ايه يا عبد المحسن؟ عبد المحسن ناااااااام مني (الله يسامحك) ..عبد المحسن : شايف الدنيا صفرا ليه ، هو فيه عاصفة النهاردة كمان؟ .. رديت عليه : لا يا عبد المحسن كمل نومك ، السطر الأصفر اللي ظهر ده سببه إننا ضغطنا F8 .. ودا فايدته إننا هنقوم بعملية التنفيذ واحدة واحدة .. سطر سطر .. السطر الأصفر على أول سطر في الكود Sub NumberRange() اضغط F8 مرة تانية ، ايه اللي حصل انتقل السطر الأصفر للسطر التالت ، طيب والسطر التاني يا معلم .. ملوش لازمة !!! أكبر خطأ إنك تعتقد إنه ملوش لازمة ، لما ضغطنا F8 للمرة التانية ، محرر الأكواد خزن في الذاكرة كل المتغيرات الموجودة في الكود عايز تتأكد من كلامي ، حرك مؤشر الماوس اللي على شكل حرف I (فيه شرطة فوق وشرطة تحت) حرك الماوس من غير ما تدوس كليك .. واقف على المتغير X هتلاقي تلميح في مستطيل صغير بيقولك المتغير X=0 ، دي كدا القيمة المبدئية للمتغير ... لما تضغط F8 للمرة التالتة ، روح شوف قيمة X مرة تانية هتلاقي قيمة X=1 (ايه اللي خلاها 1 مش كانت صفر من لحظة ) اللي حصل إننا انتقلنا من السطر For X = 1 To 10 والسطر دا هيبدأ في عمل الحلقة التكرارية اللي بنقول عليها ، والحلقة بدايتها 1 زي ما حددنا (وطبعاً ممكن نغير نقطة البداية يا شباب .. مش شرط 1) حرك مؤشر الماوس من غير ما تدوس على المتغير X في السطر المظلل بالأصفر Range("A" & X).Value = X هنلاقي زي ما قلت إن X =1 يعني محرر الأكواد هيعمل ايه دلوقتي ، هيشيل كل X ويحط مكانه القيمة 1 ، فيصبح السطر في الذاكرة بهذا الشكل Range("A1").Value = 1 لحد كدا تمام التمام ، صغر محرر الأكواد بحيث تكون ورقة العمل ظاهرة بالنسبة لك واتأكد إن النطاق A1:A10 فارغ ليس به أي بيانات ، وركز في ورقة العمل ، واضغط F8 عشان تنقل السطر الأصفر إلى هذا السطر ، ولاحظ ورقة العمل Next X لاحظت يا منصور الخلية A1 وضعت فيها القيمة 1 ، نخلي بالنا إن السطر الأصفر بيتم تنفيذه بعد الخروج منه ، فلما خرجنا من السطر تم تنفيذ الأمر وأعطى القيمة 1 للخلية A1 .. اضغط F8 مرة أخرى ، ونلاحظ إن السطر الأصفر انتقل للسطر اللي قبليه ، مش لبداية الحلقة التكرارية ، يعني ببساطة السطر اللي بيحدد بداية الحلقة ونهايتها بيعدي عليه مرة واحدة فقط .. أما سطر الأمر والسطر اللي فيه كلمة Next بيبدل السطر الأصفر عليهم... نبص دلوقتي على قيمة المتغير X هنلاقيها بقت 2 فيتم تنفيذ السطر بمجرد الضغط على F8 ويضع القيمة 2 في الخلية A2 وهكذا ..جرب واضغط F8 وفي كل مرة شوف قيمة المتغير X وشوف النطاق A1:A10 في كل مرة أول ما توصل قيمة المتغير X إلى الرقم 10 تتوقف الحلقة التكرارية ، وينتقل السطر الأصفر لجملة End Sub .. وينتهي عمل الكود .. عارف إني طولت في النقطة اللي فاتت ، بس كان لازم أطول فيها ، عشان أنا فاضي ومفيش ورايا شغل ، فقلت أصدعكم شوية!! ننتقل لمثال آخر --------------- عشان نقدر نفهم إزاي نستفيد من الحلقات التكرارية .. عايزين نعد الاسم (أحمد) في النطاق A1:A10 نفترض إني عندي الأسماء دي في النطاق A1:A10 أحمد ياسر سليم حسام عيسى أحمد أحمد خليل عبد الله أحمد المطلوب : نشوف الاسم (أحمد) كم مرة تم تكراره .. المعطيات : استعن بالله ثم بالحلقة التكرارية .. الفكرة : هنعمل اختبار صغير بقاعدة IF وهنقول لو قيمة الخلية بتساوي "أحمد" .. زود المتغير Counter بقيمة واحد Sub CountName() Dim X As Long Dim Counter As Long For X = 1 To 10 If Range("A" & X).Value = "أحمد" Then Counter = Counter + 1 Next X MsgBox Counter End Sub عملنا متغير جديد باسم Counter عشان لما يتحقق الشرط ويلاقي الاسم "أحمد" يقوم يخلي المتغير Counter يساوي نفسه + 1 طيب ليه يساوي نفسه ، عشان في كل مرة يلاقي أحمد قيمته هتتغير فلازم نضيف واحد لكل Counter جديد النتيجة في الآخر هتظهر في رسالة ، وهي 4 .. طيب نجرب نشيل الواحد في هذا السطر Counter = Counter + 1 لو شيلنا الواحد هتكون النتيجة 0 ، لأن المتغير قيمته المبدئية صفر ، فلما يتحقق الشرط مش هيزيد المتغير إلا لما نضيف واحد في كل مرة يتحقق الشرط. هناخد مثال آخر ---------------- عندنا درجات في النطاق A6:A15 ، عايزين نكتب ناجح أوراسب في الخلية المجاورة للدرجة ، لو الدرجة أكبر من أو يساوي 50 يبقا ناجح ، مكانش يكون راسب ... نخلي بالنا أنا غيرت بداية النطاق عشان الحلقة التكرارية بردو هتتغير بدايتها ونهايتها طبقاً للصفوف الجديدة 58 41 88 40 50 40 98 94 60 35 نجرب الكود التالي .. Sub LoopsTest() Dim X As Long For X = 6 To 15 If Cells(X, 1).Value >= 50 Then Cells(X, 2).Value = "ناجح" Else Cells(X, 2).Value = "راسب" End If Next X End Sub نلاحظ الحلقة التكرارية بدأت من 6 إلى 15 (ودا متغير للصفوف من الصف رقم 6 إلى الصف رقم 15) ووضعنا الشرط بين سطري الحلقة التكرارية ، لو الخلية اللي في الصف X والعمود الأول أكبر من أو يساوي 50 يقوم يعمل ايه؟ يضع القيمة النصية "ناجح" في الخلية اللي في العمود الثاني والصف X (نفس الصف بالطبع لأن قيمة X في الحالة دي هي هي نفس القيمة لأننا في نفس اللفة) .. إذا لم يتحقق الشرط قام بتنفيذ الجزء الثاني بأن يكتب النص "راسب" ثم إغلاق جملة IF بالجملة End IF ومننساش القفلة زي ما اتعودنا.. ننتقل لآخر مثال في الحلقة دي (عشان أنا تعبت وإنتو كمان أكيد تعبتو) في الأمثلة اللي فاتت عملنا حلقات تكرارية للصفوف .. واحد بيقولي طيب والأعمدة ملهاش نصيب في الدوخة اللي إحنا فيها دي .. أقوله أكيد ليها نصيب .. المطلوب إننا في الصف الرابع ، نكتب معادلة =COLUMN() بس في الأعمدة من العمود رقم 1 إلى العمود رقم 15 (A To O) نعقدها شوية ونقول في الأعمدة اللي رقمها فردي بس (الأعمدة اللي رقمها زوجي مش محتاجينها) يعني ببساطة عايزين نحط المعادلة في الأعمدة A C E G I K M O Sub ColumnsLoop() Dim X As Long For X = 1 To 15 Step 2 Cells(4, X).Formula = "=COLUMN()" Next X End Sub الحلقة التكرارية بدأت من العمود الأول حتى العمود رقم 15 (البداية والنهاية) معلومة جديدة Step 2 (دي معناها إننا هنقفز ..والقفز هيكون بمقدار 2 أي خطوتين) بدأنا بـ 1 فلما نقفز بمقدار 2 ، هنروح لرقم 3 ، أي أن المتغير سيكون رقم فردي في كل مرة 1 ، 3 ، 5 ، 7 ، 9 ، 11 ، 13 ، 15 (وهو دا المطلوب بالضبط) سطر الأمر فيه الخاصية Formula ودي عشان نقدر نضع معادلة من خلالها .. والمعادلة ببساطة زي ما شفناها من شوية بس بتكون بين أقواس تنصيص .. طيب الجزء الأول من السطر نلاحظ إننا استخدمنا Cells ودي بتكون متبوعة بقوسين ، وبين القوسين رقم الصف ثم فاصلة ثم رقم العمود ، وبما إن رقم الصف ثابت اللي هو رقم 4 ، فكتبناه زي ما هو .. اما رقم العمود فمتغير فوضعنا رقم العمود X ... جرب الكود وشوف النتيجة بنفسك أرجو أن أكون قد وفقت في توصيل المعلومة بأسلوب مبسط كان معكم أخوكم أبو البراء من تراك أوفيسنا (لف على الحلقات من الحلقة رقم 1 إلى الحلقة رقم 14 .. لو عايز تتعلم الـ VBA) ويا رب ميكونش فيه حد جاله دووووووووخة من كتر اللف .. والله أنا اللي دوخت أستودعكم الله .. دمتم في رعاية الله تقبلوا تحياتي .. دمتم بود

هناك طريقة اخررى عن طريق الدالة INDEX (INDEX(B2:B5+C2:C5+D2:D5,MATCH(G4,A2:A5,0),0 Vlookup+Arr.rar

من هنا مرفق المثال Q6.rar