يوسف عطا

الله ينور عمل متعوب فيه أقترح الآتى 1. إضافة اللغة الفرنسية بعد التربية الدينية وهى من 30 درجة والنجاح من 12 وهى ليست مادة رسوب ( حتى الآن ) ويمكن جعلها إختيارية بتشيك بوكس أى تظهر إذا تم وضع علامة تفيد العمل بها 2. زيادة العدد فى الشيت إلى 1500 طالب 3. حماية بيانات الطلاب و أسمائهم و شيت الشهادات بكلمة حماية حيث لا ينبغى أن تكون الاسماء متاحة لمن يرصد الدرجات أى يتم إزالة الأسماء وأرقام الجلوس من شيتات رصد التحريرى والإكتفاء فقط بالرقم السرى والله الموفق

Sub حماية() Cells.Select Selection.Locked = True Selection.FormulaHidden = True End Sub

تم شرح الكود سطر سطر بالتفصيل يا أستاذة فى المشاركة السابقة

شرح أكواد الطباعة بالملف الكود الأول طبع جميع الشهادات Sub printall()إسم الكود Range("I5").Selectإسم الخلية التى بها الرقم المسلسل لأول شهادة ActiveCell.FormulaR1C1 = "1" التسلسل المستخدم Activewindow.SelectedSheets.PrintOut Copies:=1, Collate:=True إطبع إطار الطباعة الذى أمامك نسخة واحدة Do بعد ذلك قم بالتالى ActiveCell = ActiveCell + 3 الرقم المسلسل التالى هو الرقم الحالى + 3 وهو عدد الشهادات فى الصفحة عند الطباعة Activewindow.SelectedSheets.PrintOut إطبع إطار الطباعة المحدد بالتتالى Loop Until ActiveCell.Value >= Range("c1").Value إستمر فى الطباعة المتتالية حتى تصل لرقم مسلسل أكبر من أو يساوى الرقم الموجودج فى الخلية سى 1 Range("a1").Select قف بالمؤشر فى الخلية A1 بعد إنهاء المهمة End Sub نهاية الكود الكود الثانى طبع الثلاث شهادات الموجودة أمامك حالياً Sub اطبع() إسم الكود Activewindow.SelectedSheets.PrintOut Copies:=1, Collate:=True إطبع إطار الطباعة الذى أمامك نسخة واحدة End Sub نهاية الكود عشمى أن أكون وفقت فى شرح الكودين والله أعلم

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

تفضلى يا أستاذة زمزم لو هذا العمل يؤدى الغرض أنا جاهز للشرح علماً بأن الصفحة تطبع 3 شهادات متتالية وصفحة الشهادات مربوطة بصفحة الشيت كنترول أى أن أى تعديل فى الدرجات فى الشيت يتغير تلقائياً فى صفحة الشهادات أتمنى أن يكون هذا طلبك Control.rar

ملاحظاتكم فى محلها ودى طريقة أخرى أسهل لجمع خلايا غير متجاورة حتى لو كان فى بعضها نصوص فهى تعتبر أى نص كأنه صفر =SUM(A2;C2;E2;G2;J2;L2;N2;Q2;T2;V2;Z2;AA2;AD2) نستخدم الطريقة دى فى حالة لو كانت توجد خلايا بها أرقام ولكننا لا نريد أن يتم جمع محتواها مع باقى الخلايا

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

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

يتم ذلك عن طريق إستخدام معادلة IF حيث يتم إحتساب القيم النصية بصفر مثلاً مثال =IF(AND(L54="غ";W54="غ";AH54="غ";AT54="غ";BH54="غ";BU54="غ";CG54="غ");0;SUM(L54;W54;AH54;AT54;BH54;BU54;CG54)) على إعتبار إنك بتجمع خلايا غير متجاورة وبعضها به حرف غ فى السطر الـ 54

الف شكر يا أخى الحبيب

تم ضبط الإحصائية ولكن ليس تماماً فالكود يعتبر أن شيت البيانات (السجل) هو فصل رقم 1 ويعتبر فصل رقم 1 هو فصل رقم 2 وهكذا المطلوب أن يسمى كل شيت بإسمه فى الإحصائية وهناك طلب آخر لو أمكن عند لصق البيانات اثناء الترحيل هل يمكن أن يلصقها فى عمودين مثلاً يصبح العمود الأيمن مسلسله من 1 إلى 30 والعمود الثانى من 31 إلى آخر الإحصاء حسب عدد كل فصل علماً بأننى أحتاج أن يكون العمود A خالياً العمود B للمسلسل أ العمود C للاسماء أ العمود D لرقم الفصل أ الأعمدة E و F و G و H خالية العمود I للمسلسل ب العمود J للاسماء ب العمود K لرقم الفصل ب الأعمدة L و M وN و O خالية على اساس أن المجموعة أ ستكون الأسماء على النصف الأيمن من الصفحة والمجموعة ب ستكون للأسماء على النصف الايسر من الصفحة هل هذا ممكن ؟ مرفق الملف يوسف ترحيل.rar

يؤسفنى أن أنعى لكم خبر وفاة والدة الأخ الغالى سعيد بيرم ندعوا الله أن يجعل مثواها الجنة وأن يلهم أهلها الصبر والسلوان ولا أراكم الله مكروهاً فى عزيز لديكم

الف شكر على إهتمامك بالموضوع أخى بن علية جارى تغيير التغييرات المذكورة ولو لم يفلح الأمر سأرفق الملف

تم إستخدام الكود كما يلى وكل شئ تمام ما عدا رسالة الإحصاء التى تظهر بعد الترحيل فهى تكون سالب 3 فى كل البيانات والسلسلة تم إنجازها تمام والحمدلله المطلوب تعديل الجزء الأخير من الكود الذى يقوم بإخراج الإحصائية فى مسدج بوكس For J = 1 To 7 Sheets(J).[B5] = 1 rrw = Sheets(J).[A3000].End(xlUp).Row For Each cc In Sheets(J).Range("B6:B" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next J MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") For k = 1 To 6 y = Sheets(k).[A3000].End(xlUp).Row - 4 mssg = mssg & Chr(10) & Format(y, "00") & " Students to Sheet : " & k Next k MsgBox (" تم ترحيل عدد" & mssg) Range("a1").Select Application.ScreenUpdating = True End Sub

إن شاء الله وفقت يا أخى الغالى وجارى التجربة والف شكر لك يا الغلا وكل عام وأنت بخير جعل الله ايامك كلها أعياد

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

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

راجع موضوع قديم للأخ الغالى خبور خير بعنوان كاس العالم http://www.officena.net/ib/index.php?showtopic=32562

ربما يتم ذلك فى حالة تغيير كلمة PasteSpecial xlPasteValues إلى PasteSpecial xlPasteValues + PasteSpecial xlPasteformats والله أعلم

الله ينور عليك يا استاذنا الغالى صحيح حرف واحد ناقص فى الكود يخلى الواحد يلف حوالين نفسه لو تكرمت كان فى طريقة بتقوم بعد الترحيل بإخراج إحصائية بعدد البيانات المرحلة فى كل شيت وعمل تسلسل تلقائى فى كل شيت هل ممكن المساعدة فى عمل هذه الإحصائية والتسلسل التلقائى هنا فى هذا الكود ؟؟ علما بأن التسلسل التلقائى سيكون فى العمود B بدءاً من الخلية B5 إلى آخر سطر يكون فيه بيانات مرحلة ومرفق جزء من كود قديم يحتوى على إحصائية مشابهة وتسلسل مشابه Next a Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" ' وهنا تطوير طفيف ليلائم العدد المتغير للحالات For i = 1 To case_NO x(i) = Sheets(sht(i)).[A3000].End(xlUp).Row - 10 mssg = mssg & Chr(10) & x(i) & " " & sht(i) Next i MsgBox (" تم ترحيل عدد" & mssg) Range("a1").Select ' وأخيرا هذا الجزء لضبط المسلسل في الشيتات التي حدث الترحيل إليها For i = 1 To case_NO Sheets(sht(i)).[A11] = 1 rrw = Sheets(sht(i)).[A3000].End(xlUp).Row For Each cc In Sheets(sht(i)).Range("A12:A" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next i On Error Resume Next On Error GoTo 0 End Sub الف شكر للغاليين وكل عام وأنتم بخير

الف شكر أخونا الغالى والحبيب بن علية ولا حرمنا الله من جمايلكم وكل عام وأنتم بخير

الرجاء المساعدة فى تصحيح الكود التالى مع توضيح الخطأ للتعلم الكود يقوم بترحيل الطالبات من السجل العام للصف إلى فصولهن Sub ترحيل_فصول() ''' متغيرات بعدد الصفحات المطلوب الترحيل اليها Dim R As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer ''' أسماء الصفحات المطلوب الترحيل اليها والمدى المطلوب مسح البيانات القديمة منه Sheets("1").Range("A5:DZ5000").ClearContents Sheets("2").Range("A5:DZ5000").ClearContents Sheets("3").Range("A5:DZ5000").ClearContents Sheets("4").Range("A5:DZ5000").ClearContents Sheets("5").Range("A5:DZ5000").ClearContents Sheets("6").Range("A5:DZ5000").ClearContents ''' عدد الصفوف العليا في الصفحات المنقول اليها البيانات A = 4: B = 4: C = 4: D = 4: E = 4: F = 4 Application.ScreenUpdating = False ''' بداية ونهاية صفوف الورقة المصدر For R = 5 To 5000 ''''''''''''''''''''''''''''''''''''''''''''''''''' ''تكرر الأسطر التالية لكل شيت يتم الترحيل فيه مع تغيير المتغيرات ''' رقم عمود المعيار وكلمة المعيار If Cells(R, 4) = "1" Then ''' عدد الأعمدة التى سيتم ترحيلها Range("A" & R).Resize(1, 9).Copy ''' سيتم اللصق في هذا الشيت Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "2" Then Range("A" & R).Resize(1, 9).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "3" Then Range("A" & R).Resize(1, 9).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "4" Then Range("A" & R).Resize(1, 9).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "5" Then Range("A" & R).Resize(1, 9).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' If Cells(R, 4) = "6" Then Range("A" & R).Resize(1, 9).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 ''''''''''''''''''''''''''''''''''''''''''''''''''''' ' If Cells(R, 4) = "1" Then ' Range("A" & R).Resize(1, 9).Copy ' Sheets("1").Range("A" & A).PasteSpecial xlPasteValues ' Application.CutCopyMode = False ' A = A + 1 '''''''''''''''''''''''''''''''''''''''''''''''''''' End If ''''''''''''''''''''''''''''''''''''''''''''''''''''' Next MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها ") Application.ScreenUpdating = True End Sub '''''''''''''''''''''''''''''''''''''''''''''''''''''

جازاك الله خير

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