مطلوب كود لاستدعاء اسماء التلاميذ حسب الفصل

[سيد الأكرت]

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

كود استدعاء.rar

[سليم حاصبيا]

13 ساعات مضت, سيد الأكرت said:

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

كود استدعاء.rar

كي يعمل الكود يجب الا يكون خلايا مدمجة في الجدول

[سليم حاصبيا]

في اي صفحة من الصفحات اضغط على الزر Button10 لتحصل على النتيجة فوراً (مرتبة ابجدياً)

في الصفحة Al_In_One توزيع الطلاب غلى الفصول

 

 

Salimكود استدعاء.rar

[سيد الأكرت]

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

Sub CallingData()
Dim data As Worksheet, Ws As Worksheet
Dim Arr As Variant, Temp As Variant
Dim I As Long, j As Long, p As Long
Set data = Sheets("السجل")
Set Ws = Sheets("مواظبة")
Ws.Range("C9:R" & Ws.Range("D" & Rows.Count).End(xlUp).Row + 9).ClearContents
Arr = data.Range("D9:t" & data.Range("D" & Rows.Count).End(xlUp).Row).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For I = 1 To UBound(Arr, 1)
If Arr(I, 2) = Ws.Range("r2") Then
p = p + 1
For j = 1 To 15
Temp(p, j) = Arr(I, Choose(j, 1, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17))
Next
End If
Next
If p > 0 Then Ws.Range("D9").Resize(p, UBound(Temp, 2)).Value = Temp
If p > 0 Then Ws.Range("C9") = 1: Ws.Range("C9").Resize(p).DataSeries Step:=1
End Sub

 

تم تعديل يناير 30, 2018 بواسطه سيد الأكرت

[سليم حاصبيا]

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

قمت يتغيير اسماء الصفحات وادراج صف فارغ قبل البيانات  لحسن عمل الكود

Salimكود استدعاء On One Page.rar

[سيد الأكرت]

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