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

إضافة تعديلات جديدة و هي: التعديل على نوع الخط و حجمه و لون الكتابة لتقرير و أنت في المعاينة و أتمنى مشاركة إخوتي و أساتذتي و أصدقائي @jjafferr و @Shivan Rekany و @ابوخليل و @رمهان و @أبو آدم و @محمد طاهر و @AlwaZeeR في هذا الموضوع لزيادة الفائدة الشرح موجود في الصورة أسفله شريط طباعة.rar

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

اللهم امين اجمعين شكرا لك اخي الحبيب

اتفضل تم استخدام هذا الكود Private Sub ÃãÑ26_Click() Me.OrderByOn = True If Me.Frame28 = 1 Then Me.OrderBy = "[NAME] ASC" ElseIf Me.Frame28 = 2 Then Me.OrderBy = "[Country] ASC" ElseIf Me.Frame28 = 3 Then Me.OrderBy = "[City] ASC" ElseIf Me.Frame28 = 4 Then Me.OrderBy = "[game] ASC" ElseIf Me.Frame28 = 5 Then Me.OrderBy = "[AGE] ASC" End If End Sub Private Sub ÃãÑ27_Click() Me.OrderByOn = True If Me.Frame28 = 1 Then Me.OrderBy = "[NAME] DESC" ElseIf Me.Frame28 = 2 Then Me.OrderBy = "[Country] DESC" ElseIf Me.Frame28 = 3 Then Me.OrderBy = "[City] DESC" ElseIf Me.Frame28 = 4 Then Me.OrderBy = "[game] DESC" ElseIf Me.Frame28 = 5 Then Me.OrderBy = "[AGE] DESC" End If End Sub Sort1.rar

استخدم ھکذا Kill Me.T11 يجب ان يكون في حقل تي 11 مسار بالكامل مع نوعية الملف مثلا E:\TestExcel.XLSB

بعد إذن أستاذنا ومعلمنا محمد يوسف مطلوب ترحيل بيانات الناجحين والراسبين.xlsx

السلام عليكم و رحمة الله تعالى وبركاته إخوتي الكرام حياكم الله. بعد نزع خاصية انشاء شريط القوائم بالأكسس في النسخ بعد 2003 أصبح هناك عائق كبير في إضافة هذه الأشرطة و لأنه يتوجب عليك العمل على ملف 2003 أو استعمال Ribbon بلغة Html و هي أصعب من الفكرة الأولى. مما جعلني أفكر في طريقة تجعلنا نستغني عن هذه الطرق المرهقة بعض الشيء. و قمت بتصميم برنامج يستطيع أن يضيف شريط قوائم للنموذج الرئيسي لقاعدة البيانات مهما كانت نسختها 2003 أو النسخ التي تأتي بعدها. نبدأ على بركة الله في شرح البرنامج: بعد فتح البرنامج نتبع الخطوات التالية: 1 - أكتب اسم القوائم التي تريد أن تضيفها مع وضع رقم كل قائمة بالترتيب (1,2,3,....و هكذا) 2- أضف العناصر أو الأوامر التي تندرج تحت كل قائمة في النموذج الفرعي رقم العنصر , تسمية العنصر ثم الكود الذي تريد أن ينفذه هذا العنصر 3- أختر قاعدة البيانات سواءا كانت 2003 أو ما بعدها ثم اختر اسم النموذج الذي تريد أن تضيف له الشريط 4- قم بالضغط على زر "إنشاء الشريط" 5- افتح قاعدة بياناتك و أنظر للشريط المضاف حتى لو كان النموذج منبثق و شاشة الأكسس مخفية سوف ترى الشريط شروط استخدام البرنامج: 1- قبل البدئ أحفظ نسخة إحتياطية من قاعدة بيانات 2- يجب أن لا يكون لديك في قاعدة بيانات نماذج بهذه الأسماء : list1,list2,list3..... و هكذا 3- يجب أن يكون حدث عن النقر للنموذج الرئيسي خال من أي كود 4-بعد الإنتهاء أدعولي و لوالدي و لعائلة بالخير و الصلاح. هذا هو البرنامج انشاء شريط قوائم.rar

السلام عليكم ورحمة الله ( اللهم صل وسلم على سيدنا ونبينا محمدواله وصحبه ) وبعد في المثال المرفق أريد فرز السجلات حسب الحقل المحدد برمجيا و يكون ( تصاعديا وتنازليا ) ولكم وافر الشكر والتقدير >>>>>>>>> ملاحظــــــة ضغط الملف rar 5.5 Sort1.rar

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

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

اتفضل تم عمل بخطوتين اولا هذه الاستعلام التجميعي هكذا SELECT جدول2.التسلسل, جدول2.التاريخ, جدول2.الاسم, جدول2.[نوع العرض], جدول2.[سعر النتج], جدول2.[نوع البيع] FROM جدول2 UNION ALL SELECT جدول1.التسلسل, جدول1.التاريخ, جدول1.الاسم, جدول1.[نوع العرض], جدول1.[سعر النتج], جدول1.[نوع البيع] FROM جدول1; وفي مصدر نموذج الفرعي تم استخدام هذا استعلام SELECT Query1.التسلسل, Query1.التاريخ, Query1.الاسم, Query1.[نوع العرض], Query1.[سعر النتج], Query1.[نوع البيع] FROM Query1 WHERE (((Query1.التاريخ)=[Forms]![FRM1]![n1])); حركة.rar

السلام عليكم حسب ما فهمت ، ان كنت تريد ان يكون التصفية ديناميكية لا ثابته، يرجى إلقاء نظره علي هذا المرفق Sub filter() Dim filterRule As Variant Dim FindString As String Dim Rng As Range Dim testRange As Range Dim targetWorksheet As Worksheet ActiveSheet.Range("$A$1:$E$10").AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("M1").Value FindString = ActiveSheet.Range("M1").Value If Trim(FindString) <> "" Then With ActiveSheet.Range("A:A") Set Rng = .Find(What:=FindString, _ After:=.Cells(.Cells.Count), _ LookIn:=xlValues, _ LookAt:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=False) If Not Rng Is Nothing Then With ActiveSheet .Cells(Rng.Row, 2).Select Set testRange = .Range(.Cells(Rng.Row, 2), .Cells(Rng.Row, ActiveSheet.Range("N1").Value)) End With testRange.Select Selection.Copy Selection.PasteSpecial xlPasteValues Application.CutCopyMode = False Else MsgBox "Nothing found with '" & FindString & "'" End If End With End If End Sub Dynamic filtering.xlsm

ما شاء الله عليك يابو محمد ربنا يزيدك علما تحياتي اليك ابو زاهر

شكرا استاذ شفان هذا هو المطلوب

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

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

Option Explicit Sub fixe_date() Dim i%: i = 6 Do Until Cells(i, 4) = vbNullString If Int(Cells(i, 4)) = Cells(i, 6) Then _ Cells(i, 4).Value = Int(Cells(i, 4).Value) i = i + 1 Loop End Sub يعد اذن اخي شوقي هذا الكود الملف مرفق تحويل معادلة التاريخ الى ناريخ عادى بشرط salim.xlsm

تم العلاج لکن القاعدە بھا ناقص جدول المعھد تم استخدام ھذا الكود لكي توصل الى طلبك اختر نوع و نتيجة والصف والجنسية و والمرحلة سيعطيك النتائج حسب ما تختار مع هذا الكود Private Sub Command36_Click() DoCmd.OpenReport "ge", acViewReport, , "[الجنسية]=" & Me.الجنسيات & _ "and [الصف]=" & Me.مربع_تحرير_وسرد11 & _ "and [نتيجة الطالب]=" & Me.مربع_تحرير_وسرد19 & _ "and [النوع]=" & Me.مربع_تحرير_وسرد23 & _ "and [المرحلة]=" & Me.مربع_تحرير_وسرد15 End Sub لكن يجب ان تختار لكل حقول work.rar

اضف Me.Undo في الكود بعد سطر Else طابة 2.rar

يتم ذلك بكود ترحيل ناجح وراسب راجع الرابط التالى حا يفيدك كتير

السلام عليكم يمكن بالمعادلة التالية مطبقة على النطاق A7:A11 في الملف المرفق: =SUMPRODUCT(TRUNK(A7:A11;2)) جمع رقمين فقط بعد العلامة.rar

ممكن ترسله على الاميل التالي وبارك الله فيك وفي مجهودك fbuhawia@gmail.com او تحميله على google drive لو سمحت

اليك هذا الماكرو الذي يدرج لك 4 معادلات قي كافة الصفجات كل واحدة في مكانها المناسب لا وقت لدي لتكملته (تستطيع انت فعل ذلك بنفس الطريقة) الماكرو Option Explicit Sub Salim_Macro() 'هذا الماكرو يدرج 4 معادلات تسطيع ان تكمله لادراج كافة المعادلات Dim Y$ Dim x%, i%, K%: K = Sheets.Count For i = 2 To K x = Sheets(i).Index '===================== fromula in D5========== Y = "='0'!B" & x + 2 Sheets(i).Range("d5") = Evaluate(Y) '===================== fromula in d8========== Y = "=IF('0'!C" & x + 2 & ",'0'!C" & x + 2 & ","""" )" Sheets(i).Range("d8") = Evaluate(Y) '===================== fromula in F10========== Y = "=IF('0'!D" & x + 2 & ",'0'!D" & x + 2 & ","""" )" Sheets(i).Range("f10") = Evaluate(Y) '===================== fromula in M10========== Y = "=IF('0'!E" & x + 2 & ",'0'!E" & x + 2 & ","""" )" Sheets(i).Range("M10") = Evaluate(Y) Next End Sub الملف مرفق اضغط فقط على الزر RUN في الصفجة 0 B6_salim.xls

قم بتنشيط كل الصفحات دفعة واحدة و ذلك حسب الخطوات التالية: 1 اضغط بشكل متواصل على Ctrl , واختر الصفحات المطلوبة واحدة بعد الاخرى يواسطة نقر الماوس على اسمها 2 اترك الزر Ctrl 3 اكتب المعادلة المطلوبة (يمكنك سحب المعادلة الى اكثر من صف او عامود) و هكذا نكتب المعادلة في كل الصفحات لالغاء تحديد مجموعة الصفحات قم بالضفط على صفحة ليست في هذ المجموعة شاهد هذا الفيديو

بالطبع توجد طريقة وهي : من تبويب إدراج ستجد خيار إدراج كائن ومنه ستجد خيار من ملف نصي سيظهر مربع لتحديد الملفات المراد دمجها قم باختيارها وستتم عملية دمج جميع الملفات المحددة

ادراج رزنامة شهرية لسنة معينة و شهر معين (باختيارك) بدون يوم او يومين تحددهما بنفسك و اذا لم تحدد الايام (بمسح الخلايا المناسبة) يتم ادراج كامل الشهر Sub Give_date_without_same_days() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With If Not IsNumeric([a2]) Or Not IsNumeric([b2]) _ Or [b2] < 1 Or [b2] > 12 _ Or IsEmpty([a2]) Or IsEmpty([b2]) Then MsgBox "أدخل أرقاماً صحيحة في الخلايا " & Chr(10) & "$ِِِA$2 and $B$2 " & Chr(10) _ & "وأعد المحاولة", vbOKOnly + vbInformation + vbMsgBoxRight + vbMsgBoxRtlReading, "!...ٍSalim" Range("c4:Ag5").ClearContents Range("c4:Ag5").Borders.LineStyle = 0 GoTo Exit_Me End If With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlManual End With Dim Array_Days(), My_Days_Arabic() Dim Arab_Day(), My_Date_For_Print() Dim Array_Numbers() Dim t As Date, i%, k%, m%, x%, last_col% Dim y$ '============================== Array_Days = Array("sun", "mon", "tue", "wed", "thu", "fri", "sat") Arab_Day = Array("الأحد", "الإثنين", "الثلاثاء", "الأربعاء", "الخميس", "الجمعة", "السّبت") Array_Numbers = Array(1, 2, 3, 4, 5, 6, 7) last_col = Cells(5, Columns.Count).End(1).Column Range("c4").Resize(2, last_col).ClearContents Range("c4").Resize(2, last_col).Borders.LineStyle = 0 '================================= [a2] = Int([a2]): [b2] = Int([b2]) t = DateSerial([a2], [b2], 1) x = Day(Application.EoMonth(t, 0)) k = 1 For i = 1 To x y = Application.Index(Arab_Day, Application.Match(Weekday(t), Array_Numbers, 0)) If Trim(y) = Trim([d2].Value) Or _ Trim(y) = Trim([e2].Value) Then GoTo 2 ReDim Preserve My_Days_Arabic(1 To k): My_Days_Arabic(k) = y ReDim Preserve My_Date_For_Print(1 To k): My_Date_For_Print(k) = t k = k + 1 ' End If 2: t = t + 1 Next Range("C4").Resize(1, UBound(My_Days_Arabic)) = My_Days_Arabic Range("C5").Resize(1, UBound(My_Date_For_Print)) = My_Date_For_Print Range("C4").Resize(2, UBound(My_Days_Arabic)).Borders.LineStyle = 1 ActiveSheet.PageSetup.PrintArea = "" ActiveSheet.PageSetup.PrintArea = Range("a1").Resize(6, UBound(My_Days_Arabic) + 2).Address Exit_Me: Erase Array_Days: Erase Arab_Day: Erase Array_Numbers With Application .ScreenUpdating = True .Calculation = xlAutomatic .EnableEvents = True End With End Sub Private Sub CommandButton1_Click() Give_date_without_same_days End Sub Private Sub Worksheet_Activate() With CommandButton1 .Left = 469: .Top = 18.5: .Width = 154.5 End With End Sub الكود موجود ضمن الملف Date_sans_deux_jours.xlsm

بارك الله فيك اخي

السلام عليكم يمكنك استخدام خاصية Task Scheduler في ويندزو 10 و اختيار التوقيت و الملف ز لاخيار الملف و فى الاصدارات السابقة اعتقد Start All Programs Accessoris System Tools Task Scheduler

اخي انا حملته والرساله شغاله ميه في الميه شوف الصورة المخزون 89 وانا عملت 90 ولم يقبل واعطا رساله

تفضل هذا هو التعديل كما تريد التقرير.rar

اهداء الى كل من تعلمت منهم كل جديد كل من قام بمساعدتى لوجه الله ولرغبته فى مساعدة الاخرين اهداء الى صاحب هذا الصرح العظيم الاستاذ محمد بارك الله فيه الاستاذ الكبير / خبور خير الاستاذ الكبير / الخالدى الاستاذ الكبير / الحسامى الاستاذ الكبير / كيماس الاستاذ الكبير / احمد حمور الاستاذ الكبير / ياسر حافظ الاستاذ الكبير / مهندس طارق الاستاذ الكبير / جمال الفار الاستاذ الكبير /دعيدى الاستاذ الكيبير / يحياوى الاستاذ الكيبر / عادل حنفى الاستاذ الكبير / احمد فضيلة الاستاذ الكبير / بن عليه الاستاذ الكبير / هشام شلبي الاستاذ الكبير / احمد زمان الاستاذ والعلامه / يحيى حسن والى من لم تسعفنى زاكرتى الضعيفة لزكر افضالة اهديكم هذا العمل المتواضع برنامج شئون الطلبة متوافق مع القرار 313 ومتطلبات الجودة فى المدارس المصرية وارجوا من الاساتذة مراجعته ومعرفه هل به اخطاء ام لا والرنامج به كميه كبيرة من الشيتات والمخرجات المفيدة والتى تساعد فى اعمال شئون الطلبة فى المدارس المصرية ومنها التالى اولا قوائم الفصول 1/ قائمن فصل بناظام لبنون ثم البنات ومعهم الرقم الكودى للمتعلم + الرقم القومى 2/ قائمة فصل النون فى نصف الورقة والبنات فى النصف الثانى ومعهم الرقم الكودة والرقم القومى 3/ قائمة فصل ومبين امام كل متعلم الانسطة الاختيارية التى اختارها 4/ سجل مدرسي كامل للفصل 5/كشوف حالات القيد الاجمالية 6/كشوف حالات القيد التفصيلية 7/الكارنيهات المدرسية 8/بطاقة بيانات تفصيلية لكل طالب يتم لصقها على ملفات الطلبة 9/التحويلات من والى المدرسة 10 /المتعلمون بدون رقم قومى 11/ احصاء تفصيلى عام للمدرسة ثانيا الغياب : 1/ كشف اجمالى لتسجيل عدد مرات الغياب 2/ سجل 5 سلوك 3/ سجل اجمالى مرات التأخر والغياب ثالثا : المصرفات 1/ شيت تسجيل المصروفات 2/ كشوف للطباعة بالطلبة المسددين للمصروفات كلى او جذئي 3/ احصاء عام لسداد المصروفات رابعا : الاخصائي الاجتماعى 1 / عمل دعوة لمجلس الاباء 2 / بيانات الاتصال باولياء الامور 3 / كشوف لتوقيع اولياء الامور باستلام الدعوات 4 / كشوف بالحالات الخاصة خامسا : الاعمال المساعدة فى الامتاحانات 1 / ادارة قياس الجانب المهارى او الوجدانى فكرة جيدة 2 / بطاقات تتبع المستوى 3 / رصد تتبع المستوى 4 /تجميع درجات اعمال السنه للصفوف الاول والثانى والثالث 5 /تجميع درجات اعمال السنه للصفوف الرابع والحامس والسادس 6/ تجميع درجات امتحان عملى العلوم 7 / تجميع درجات الامتحانات الشفوية 8 /تجميع درجات الانشطة ******************************************* هذا والبرنامج قابل للتعديل فى اى وقت حسبما يشاء اى مستخدم وقابل للتعديل الى اى مدرسة بارك الله فيكم جميعا وكل عام وانتم بخير انتظر رأى الاساتذة الكبار برنامج شئون الطلبة .rar

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

اخى الحبيب بارك الله فيك تم بعون الله تليبه طلبك النسخه المعدله تم رفعها لك تابع واى طلبات اخيك فى الخدمه 2 شئون العاملين.rar