عبد الفتاح كيرة

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

هذا هو مع التعديل الديناميكى التام لاستعراض السجل وحفظ التغييرات مع الفريم1kemas.rar

لما تقل قيمة شريط الزيادة و النقصان عن 4 يظهر الخطا لذلك فى خواص هذا الشريط اجعل قيمته الصغرى = 4 الخاصية min = 4 هذا كل شىء

أنا نفذت التعديل بالمرفق و هو كما أردت افتح الكود و شاهد التعديلات

المرفق .Caption = Worksheets(Sh_MyDate).Cells(4, i).Value lcol = Worksheets(Sh_MyDate).Range("IV4").End(xlToLeft).Column و من خصائص شريط الزيادة و النقصان غير قيمته إلى 4 scrollbar1.value=4 الديناميكى التام لاستعراض السجل وحفظ التغييرات مع الفريم1kemas.rar

.Caption = Sheets(1).Cells(1, j).Value غيره إلى .Caption = Sheets(1).Cells(4, j).Value و ScrollBar1.Value = 1 إلى ScrollBar1.Value = 4 وهذا lcol = Sheets(1).Range("ff1").End(xlToLeft).Column لهذا lcol = Sheets(1).Range("ff4").End(xlToLeft).Column

شكرا يا أمير هذا بالفلوس جرب هذا http://www.vbtutor.net/VBA/vba_tutorial.html

أكيد يوجد اكتب فى خانة البحث excel أو إكسل دروس إكسل و استعرض النتائج

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

تفضل بالمرفقات Book1-kemas.zip

ممتاز أخانا الفاضل AHMADHAMOOR بارك الله فيك Me.Hide الأفضل unload me الإخفاء يبقى الفورم فى الذاكرة إلغاء التحميل يحذفه من الذاكرة لتوفير موارد النظام كل عام أنتم بخير

و هذا يفرز أيضا حسب عمود المحولين ثم حسب عمود المجموع Sub sort5() Dim LR2 As Long LR2 = Sheets("all").Range("b" & Rows.Count).End(xlUp).Row Range("b4:AE" & LR2).Select ActiveWorkbook.Worksheets("All").Sort.SortFields.Clear ActiveWorkbook.Worksheets("All").Sort.SortFields.Add Key:=Range("o4:O" & LR2), _ SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("All").Sort .SetRange Range("b4:AE" & LR2) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B4:AE" & LR2).Select ActiveWorkbook.Worksheets("All").Sort.SortFields.Clear ActiveWorkbook.Worksheets("All").Sort.SortFields.Add Key:=Range("W4:W" & LR2), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("All").Sort .SetRange Range("B4:AE" & LR2) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub السؤال هل هناك طريقة أفضل لتوزيع الفصول مرفق ملف توزيع الفصول.zip

السلام عليكم --- نواصل العمل : ---- من الأمور المهمة التى تتعلق بعمل الكشوف المدرسية عملية توزيع الطلاب على الفصول للعام الجديد يدويا و على أرض الواقع يكتب أمام كل طالب مجموع درجاته فى العام المنصرم ثم يؤبتث ( يعنى يؤبجد - يرتب ) الطلاب حسب المجموع الأعلى ثم الأقل و هكذا مثلا نريد التوزيع على أربعة فصول فنبدأ بالكتابة أمام الكشف المرتب حسب المجموع 1 2 3 4 ثم نكرر 1 2 3 4 وهكذا حتى آخر طالب نقلت ذلك إلى الإكسل و استخدمت كود لترتيب الطلاب حسب مجموعهم يرتب حسب عمود المجموع ثم حسب المحولين من المدرسة ثم وظيفة لتنفيذ ما سبق ثم كود لإعادة ترتيب الطلاب كما كانوا حسب الاسم هذه هى الوظيفة Sub tawz() Application.ScreenUpdating = False Dim i As Integer, mm As Integer 'عدد الفصول بشيت data mm = Sheets("الرئيسة").Range("f10").Value 'ماكرو للفرز حسب حول إلى مدرسة ثم حسب المجموع لحصر المحولين متتاليين 'فائدة ذلك عدم زيادة الفصل 1 عن باقى الفصول كثيرا لأن كل خروج من الحلقة يتبعه البدء ب 1 Call sort5 Sheets("all").Activate 'تنظيف المكان قبل العمل Range("ab5:ab1000").ClearContents 'تحديد أو خلية للفصل Range("ab5").Activate 'اعمل مادام خانة الاسم ليست فارغة Dim LR2 As Long LR2 = Sheets("all").Range("b" & Rows.Count).End(xlUp).Row Dim ww As Long Dim q As Integer For ww = 1 To Int(LR2 / mm) For i = 1 To mm If Range("ab" & i + 4 + q).Offset(0, -5).Value = "" And Range("b" & i + 4 + q).Value <> "" Then Cells(i + 4 + q, 28).Value = i End If Next i q = q + mm Next ww 'أعد الترتيب الأبجدى Call abc Application.ScreenUpdating = True Application.CutCopyMode = False Sheets("class").Select Range("a5").Select ' رأس و تذييل الصفحة With Sheets("class").PageSetup '.LeftHeader = "&""-,غامق""&12كشف رقم : &P" .LeftFooter = "&""-,غامق""&16مدير المدرسة" & " / " & Sheets(1).Range("f7") .RightFooter = "&""-,غامق""&16وكيل ش ط" & " / " & Sheets(1).Range("f8") '.RightFooter = "&""-,غامق""&16اللجنة :" End With End Sub و نجح الكود المشكلة أن أكواد الفرز لا تعمل دائما بصورة جيدة أحيانا تفرز عناوين الأعمدة فيقفز اسم طالب مكان عنوان اسم الطالب مع أن كود الفرز عملته بتسجيل الماكرو ها هى أكواد الفرز هذا يفرز حسب الاسم Sub abc() ' ' abc ماكرو ' Dim LR2 As Long LR2 = Sheets("all").Range("b" & Rows.Count).End(xlUp).Row ' Sheets("All").Select Range("b5:AE" & LR2).Select ActiveWorkbook.Worksheets("All").Sort.SortFields.Clear ActiveWorkbook.Worksheets("All").Sort.SortFields.Add Key:=Range("B5:B" & LR2), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("All").Sort .SetRange Range("b5:AE" & LR2) .Header = xlGuess .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("B5").Select End Sub

عند غلق الملف سيطالب إكسل بحفظه وبالتالى سيحسبه قبل الحفظ ى عملية حساب متوقفة حتى نضغط f9

شكرا لأستاذنا ملف كنا ننتظره منذ زمن لمعضلة العشرة الأوائل

الحمد لله على نعمه أخى لا تتردد فى سؤال أى أحد هنا فكلنا نتعلم و مرحبا بك

الحمد لله يا معلم توصلت لهذا و عمل بنجاح Union(Range("b5:f" & Lr), Range("k5:m" & Lr), Range("g5:h" & Lr)).Copy فما تفسير هذا

أستاذنا الفاضل هذا هو الكود الذى أعمل عليه الفكرة بسيطة جدا نسخ مدى غير متجاور الأعمدة إلى مدى متصل الأعمدة المشكلة عندى برقم الصف هو هنا رقم ثابت = 1000 و أنا أريده متغيرا برقم آخر صف و هو Lr انظر Dim Lr As Long Lr = Range("b" & Rows.Count).End(xlUp).Row Range("b5:f1000,k5:m1000, g5:h1000").Copy ' Range("b5:f" & Lr), ("k5:m" & Lr), ("g5:h" & Lr).Copy Sheets("41").Range("b6").PasteSpecial Paste:=xlPasteColumnWidths Sheets("41").Range("b6").PasteSpecial Paste:=xlPasteValues Sheets("41").Range("b6").PasteSpecial Paste:=xlPasteFormats السطر هذا Range("b5:f1000,k5:m1000, g5:h1000").Copy أدى المهمة لكن رقم الصف كما ترى ثابت من 5 إلى 1000 أنا أريد وضع المتغير Lr الذى يشير لآخر صف مكان ال 1000 جربت ما تحته خط لم ينفع السطر هذا Range("b5:f" & Lr), ("k5:m" & Lr), ("g5:h" & Lr).Copy لم يعمل معى كيف أصوغه بشكل سليم

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

طيب زين اقتربنا هذا إذا كان المدى صفه محددا كيف نكتبه إذا كان رقم الصف الثانى الذى هو = 100 عبارة عن متغير Range("A1:C100,F1:H100,M1:M100,Q1:R100").Copy

السلام عليكم لنعد للعمل : --- عندنا مدى غير متجاور الأعمدة مثلا a1:c100 و f1:h100 و m1:m100 و q1:r100 كل هذا مدى واحد و هو كما ترى متعدد و غير متجاور لدى سؤالان الأول : ما أفضل طريقة للإشارة لهذا المدى فى الكود الثانى : إذا كان مجموع الأعمدة فيه هو 10 متفرقة كيف نلصقه أو ننقله إلى مدى من 10 أعمدة لكن متصل يعنى ننسخه إلى a1:a10 قلتم يا أستاذ خبور أن الخلايا المنسوخة يجب أن يطابق المدى الذى سننقل إليه ------- مع الشكر

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

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

بالضبط لن تعمل إلا بعد ضغط f9 أو زر الحساب الآن