commandos1975 قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 قام أحد الزملاء بهذا العمل وقمت بالتعديل لزيادة عدد تلاميذ الفصل برجاْ طريقة زيادة عدد الفصول حيث ان المجود هو 4 فصول اريد زيادها حتي 12 فصل classes.rar رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 أخى الكريم الملف محمى ..برجاء ازالة الحماية رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 صباح الخيرات أخونا الغالى جمال بك تقبل تحياتى رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 أخى كوماندوز تفضل هذا الملف وأعتقد أنه يلبى إحتياجك كما أنه مرن سهل التعديل عليه ويحقق عدد من المميزات كود الترحيل للفصول من شيت السجل يرحل لعدد 22 فصل وكل فصل 60 طالب كما يخرج إحصاء بعدد الطلبة فى كل فصل ويستخرج إحصاء بطلاب الفصل الواحد حسب الديانة وحالة القيد أتمنى يحقق مرادك Sub ترحيل_فصول() Dim Z As Integer, A As Integer, B As Integer, C As Integer, D As Integer, E As Integer, F As Integer, G As Integer, H As Integer, I As Integer, J As Integer, K As Integer, L As Integer, M As Integer, N As Integer, O As Integer, P As Integer, Q As Integer, R As Integer, S As Integer, T As Integer, U As Integer, V As Integer Sheets("1").Range("A7:DZ5000").ClearContents Sheets("2").Range("A7:DZ5000").ClearContents Sheets("3").Range("A7:DZ5000").ClearContents Sheets("4").Range("A7:DZ5000").ClearContents Sheets("5").Range("A7:DZ5000").ClearContents Sheets("6").Range("A7:DZ5000").ClearContents Sheets("7").Range("A7:DZ5000").ClearContents Sheets("8").Range("A7:DZ5000").ClearContents Sheets("9").Range("A7:DZ5000").ClearContents Sheets("10").Range("A7:DZ5000").ClearContents Sheets("11").Range("A7:DZ5000").ClearContents Sheets("12").Range("A7:DZ5000").ClearContents Sheets("13").Range("A7:DZ5000").ClearContents Sheets("14").Range("A7:DZ5000").ClearContents Sheets("15").Range("A7:DZ5000").ClearContents Sheets("16").Range("A7:DZ5000").ClearContents Sheets("17").Range("A7:DZ5000").ClearContents Sheets("18").Range("A7:DZ5000").ClearContents Sheets("19").Range("A7:DZ5000").ClearContents Sheets("20").Range("A7:DZ5000").ClearContents Sheets("21").Range("A7:DZ5000").ClearContents Sheets("22").Range("A7:DZ5000").ClearContents A = 7: B = 7: C = 7: D = 7: E = 7: F = 7: G = 7: H = 7: I = 7: J = 7: K = 7: L = 7: M = 7: N = 7: O = 7: P = 7: Q = 7: R = 7: S = 7: T = 7: U = 7: V = 7 Application.ScreenUpdating = False For Z = 2 To 5000 If Cells(Z, 5) = "1" Then Range("A" & Z).Resize(1, 22).Copy Sheets("1").Range("A" & A).PasteSpecial xlPasteValues Application.CutCopyMode = False A = A + 1 End If If Cells(Z, 5) = "2" Then Range("A" & Z).Resize(1, 22).Copy Sheets("2").Range("A" & B).PasteSpecial xlPasteValues Application.CutCopyMode = False B = B + 1 End If If Cells(Z, 5) = "3" Then Range("A" & Z).Resize(1, 22).Copy Sheets("3").Range("A" & C).PasteSpecial xlPasteValues Application.CutCopyMode = False C = C + 1 End If If Cells(Z, 5) = "4" Then Range("A" & Z).Resize(1, 22).Copy Sheets("4").Range("A" & D).PasteSpecial xlPasteValues Application.CutCopyMode = False D = D + 1 End If If Cells(Z, 5) = "5" Then Range("A" & Z).Resize(1, 22).Copy Sheets("5").Range("A" & E).PasteSpecial xlPasteValues Application.CutCopyMode = False E = E + 1 End If If Cells(Z, 5) = "6" Then Range("A" & Z).Resize(1, 22).Copy Sheets("6").Range("A" & F).PasteSpecial xlPasteValues Application.CutCopyMode = False F = F + 1 End If If Cells(Z, 5) = "7" Then Range("A" & Z).Resize(1, 22).Copy Sheets("7").Range("A" & G).PasteSpecial xlPasteValues Application.CutCopyMode = False G = G + 1 End If If Cells(Z, 5) = "8" Then Range("A" & Z).Resize(1, 22).Copy Sheets("8").Range("A" & H).PasteSpecial xlPasteValues Application.CutCopyMode = False H = H + 1 End If If Cells(Z, 5) = "9" Then Range("A" & Z).Resize(1, 22).Copy Sheets("9").Range("A" & I).PasteSpecial xlPasteValues Application.CutCopyMode = False I = I + 1 End If If Cells(Z, 5) = "10" Then Range("A" & Z).Resize(1, 22).Copy Sheets("10").Range("A" & J).PasteSpecial xlPasteValues Application.CutCopyMode = False J = J + 1 End If If Cells(Z, 5) = "11" Then Range("A" & Z).Resize(1, 22).Copy Sheets("11").Range("A" & K).PasteSpecial xlPasteValues Application.CutCopyMode = False K = K + 1 End If If Cells(Z, 5) = "12" Then Range("A" & Z).Resize(1, 22).Copy Sheets("12").Range("A" & L).PasteSpecial xlPasteValues Application.CutCopyMode = False L = L + 1 End If If Cells(Z, 5) = "13" Then Range("A" & Z).Resize(1, 22).Copy Sheets("13").Range("A" & M).PasteSpecial xlPasteValues Application.CutCopyMode = False M = M + 1 End If If Cells(Z, 5) = "14" Then Range("A" & Z).Resize(1, 22).Copy Sheets("14").Range("A" & N).PasteSpecial xlPasteValues Application.CutCopyMode = False N = N + 1 End If If Cells(Z, 5) = "15" Then Range("A" & Z).Resize(1, 22).Copy Sheets("15").Range("A" & O).PasteSpecial xlPasteValues Application.CutCopyMode = False O = O + 1 End If If Cells(Z, 5) = "16" Then Range("A" & Z).Resize(1, 22).Copy Sheets("16").Range("A" & P).PasteSpecial xlPasteValues Application.CutCopyMode = False P = P + 1 End If If Cells(Z, 5) = "17" Then Range("A" & Z).Resize(1, 22).Copy Sheets("17").Range("A" & Q).PasteSpecial xlPasteValues Application.CutCopyMode = False Q = Q + 1 End If If Cells(Z, 5) = "18" Then Range("A" & Z).Resize(1, 22).Copy Sheets("18").Range("A" & R).PasteSpecial xlPasteValues Application.CutCopyMode = False R = R + 1 End If If Cells(Z, 5) = "19" Then Range("A" & Z).Resize(1, 22).Copy Sheets("19").Range("A" & S).PasteSpecial xlPasteValues Application.CutCopyMode = False S = S + 1 End If If Cells(Z, 5) = "20" Then Range("A" & Z).Resize(1, 22).Copy Sheets("20").Range("A" & T).PasteSpecial xlPasteValues Application.CutCopyMode = False T = T + 1 End If If Cells(Z, 5) = "21" Then Range("A" & Z).Resize(1, 22).Copy Sheets("21").Range("A" & U).PasteSpecial xlPasteValues Application.CutCopyMode = False U = U + 1 End If If Cells(Z, 5) = "22" Then Range("A" & Z).Resize(1, 22).Copy Sheets("22").Range("A" & V).PasteSpecial xlPasteValues Application.CutCopyMode = False V = V + 1 End If Next For Y = 1 To 22 Sheets(Y).[a7] = 1 rrw = Sheets(Y).[A3000].End(xlUp).Row For Each cc In Sheets(Y).Range("a8:A" & rrw) cc.Value = cc.Offset(-1, 0) + 1 Next cc Next Y MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى فصلها طبقاً للإحصاء التالى ") For X = 1 To 22 Y = Sheets(X).[A3000].End(xlUp).Row - 6 mssg = mssg & Chr(10) & Format(Y, "00") & " طالبة بفصل رقم : " & X Sheets(X).Select Range("A37:S100").Copy Range("G7").Select ActiveSheet.PasteSpecial xlPasteValuesAndNumberFormats Range("A37:F100").ClearContents Range("M1:S3").Select Selection.Copy Range("C38").Select ActiveSheet.Paste Range("A1").Select Application.CutCopyMode = False Next X MsgBox (" تم ترحيل عدد" & mssg) Range("A1").Select Application.ScreenUpdating = True End Sub قوائم فصول22 فصل.rar رابط هذا التعليق شارك More sharing options...
دغيدى قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 أخى اكريم تفضل وحتى 50 فصلا كل فصل 60 طالبا classes 2.rar رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله أخي الكريم، تجد في الملف المرفق تبسيطا واختصارا لنص كود أخي الكريم "يوسف عطا" جازاه الله عنا خير الجزاء... أخوكم بن علية قوائم فصول22 فصل.rar رابط هذا التعليق شارك More sharing options...
commandos1975 قام بنشر ديسمبر 28, 2012 الكاتب مشاركة قام بنشر ديسمبر 28, 2012 بارك اله فيكم جميعا منتدي في غاية الجمال اريد ان تكون الفصول في نفس الصفحة حتي تسهل الطباعة رابط هذا التعليق شارك More sharing options...
منياوى قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 اكثر من رائع جزاكم الله خيرا رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله وبركاته الاساتذة الافاضل جزاكم الله خيرا وانتم تتسابقون لعمل الخير وابداء المساعدة لمن يحتاج وباكثر من طريقة جعلها الله في ميزان حسناتكم الاخ commandos 1975 بالنسبة لسؤالك في المشاركة 7 ان تكون الفصول في صفحة واحدة اعتقد يوجد حل في هذا الرابط للاستاذ محمود جزاه الله خيرا http://www.officena....howtopic=44632# رابط هذا التعليق شارك More sharing options...
بن علية حاجي قام بنشر ديسمبر 28, 2012 مشاركة قام بنشر ديسمبر 28, 2012 السلام عليكم ورحمة الله أخي الكريم، تم دمج كود الترحيل إلى كود الطباعة مع بعض التعديلات حيث عند النقر على زر "طباعة كل الفصول" يتم ترحيل كل فصل إلى ورقة "الفصول" مع طباعة هذا الفصل ثم الفصل الذي يليه ثم الذي يليه إلى آخر فصل... وقد تم إنشاء جدول إضافي في ورقة "البيانات 2013" لرواد الفصول... أرجو أن يكون العمل مستوفيا المطلوب... أخوكم بن علية قوائم الفصول.rar رابط هذا التعليق شارك More sharing options...
أبو محمد عباس قام بنشر ديسمبر 29, 2012 مشاركة قام بنشر ديسمبر 29, 2012 السلام عليكم ورحمة الله وبركاته الاستاذ والاخ بن علية حاجي جزاك الله خيرا عمل خرافي وفيه لمسة الابداع واضحة وظننت انها صعبه لكثرة الاوراق لكنني ايقنت بانه لاصعب عليكم ولا على الاساتذه الكبار في هذا المنتدى الرائع زادك الله سبحانه وتعالى علما ومعرفة ودمتم في رعاية الله وحفظه رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان