اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
أعلن هنا
أعلن هنا



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





توزيع اللجان دفعة واحدة بالأكواد

الأخوة الأفاضل أعضاء المنتدى الكرام السلام عليكم ورحمة الله وبركاته أتشرف بانضمامى لأسرة هذا المنتدى العظيم وأولى مشاركا ..



08-01-2018 10:59 مساء
Haneen Amr
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 08-01-2018
رقم العضوية : 3478
المشاركات : 9
الجنس : أنثى
تاريخ الميلاد : 12-9-1976
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
الاعجاب : 2
 offline 
الأخوة الأفاضل أعضاء المنتدى الكرام
السلام عليكم ورحمة الله وبركاته
أتشرف بانضمامى لأسرة هذا المنتدى العظيم
وأولى مشاركاتى فى هذا المنتدى هو طلب أتمنى من الله أن يوفق الجميع فى مساعدتى
الطلب هو : بالبحث فى هذا المنتدى وجدت كود رائع يقوم يتوزيع اللجان للامتحان  كل لجنتين فى ورقة واحدة
ويتم الحصول على الجان الباقية باستخدام زر الزيادة والنقصان ثم الضغط على زر استدعاء اللجان





فالمطلوب بالملف المرفق هو : كيفية التعديل على الكود المرفق للحصول على كافة اللجان دفعة واحدة بضغطة زر واحدة  تحت بعضها والاستغناء عن زر الزيادة والنقصان
ولكم جزيل الشكر والعرفان
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 
 
  لجان.rar   تحميل rar مرات التحميل :(17)
الحجم :(33.65) KB







08-01-2018 11:13 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3078
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 10
يتابعهم : 0
يتابعونه : 256
قوة السمعة : 8660
الاعجاب : 2888
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
وعليكم السلام أخي الكريم
أهلاً بك في المنتدى ونورت بين إخوانك
إذا كان الغرض من طلبك هو طباعة الكشوف كلها مرة واحدة فجرب الكود التالي حيث سيقوم بعمل معاينة لكل اللجان ، ويمكنك استبدال كلمة PrintPreview بكلمة PrintOut للطباعة
Sub Print_All()
    Dim i As Long
    
    With Sheets("Legan")
        .Range("E1").Value = 1
        Call Legan_Test
        
        Do Until .Range("H11").Value = ""
            i = i + 2
            .Range("E1").Value = i - 1
            Call Legan_Test
            If .Range("H11").Value = "" Then Exit Do
            .PrintPreview
        Loop
    End With
End Sub

أثارت هذه المشاركة إعجاب: malik، مالك ماريه، ناصر سعيد1،




08-01-2018 11:55 مساء
مشاهدة مشاركة منفردة [2]
Haneen Amr
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 08-01-2018
رقم العضوية : 3478
المشاركات : 9
الجنس : أنثى
تاريخ الميلاد : 12-9-1976
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
الاعجاب : 2
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
أستاذى الكريم
بارك الله فيك
أولا : مشكور جدا سرعة الاستجابة لطلبى
فعلا كود رائع لطباعة الكل
ولكنى كنت أبحث عن كود يقوم بنسخ كل اللجان واظهارها تحت بعضها مثل الشهادادت مثلا وذلك للتبع اللجان ومراجعتها كلها قبل الطباعة
فأرجو التعديل إن أمكن للضرورة
ولكم جزيل الشكر
 





09-01-2018 07:42 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 3078
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 10
يتابعهم : 0
يتابعونه : 256
قوة السمعة : 8660
الاعجاب : 2888
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
يمكن مراجعة البيانات من الورقة التي تحتوي البيانات الأصلية ، وعموماً سأحاول العمل على الملف في أقرب وقت إلا إذا تدخل أحد الأخوة الكرام





09-01-2018 02:04 مساء
مشاهدة مشاركة منفردة [4]
Haneen Amr
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 08-01-2018
رقم العضوية : 3478
المشاركات : 9
الجنس : أنثى
تاريخ الميلاد : 12-9-1976
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
الاعجاب : 2
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
الأستاذ الفاضل / YasserKhalil
مشكور جدا لاهتمامكم
ونسأل الله أن بزيدكم من العلم
وفى انتظار ردكم أو تدخل أحد الأعضاء للمساعدة فى ايجاد الحل
 





09-01-2018 09:17 مساء
مشاهدة مشاركة منفردة [5]
Haneen Amr
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 08-01-2018
رقم العضوية : 3478
المشاركات : 9
الجنس : أنثى
تاريخ الميلاد : 12-9-1976
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
الاعجاب : 2
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
للرفع
هل من مستجيب

أثارت هذه المشاركة إعجاب: تاج الدين،




09-01-2018 11:33 مساء
مشاهدة مشاركة منفردة [6]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 422
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 433
الاعجاب : 162
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
   If .Range("H11").Value = "" Then Exit Do

هذه الجمله البرمجيه لن تجعل الكود يتوقف عن العمل لان هذه الخليه لن تكون فارغه لانها خليه اسم طالب





10-01-2018 12:11 صباحا
مشاهدة مشاركة منفردة [7]
محمد الدسوقى
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 293
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 36
يتابعهم : 7
يتابعونه : 199
قوة السمعة : 2049
الاعجاب : 477
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
أستاذى الغالى / ناصر سعيد
هذه الخلية ستكون فارغة بعد انتهاء آخر رقم للجان وهو 12 كما فى الملف المرفق
فعند استدعاء أسماء التلاميذ من رقم لجنة أعلى من 12 لن يكون هناك أسماء للتلاميذ فتصبح الخلية فارغة  فيتوقف الكود بعدها
ويمكن تجنب هذا باضافة تعليمة صغيرة فى الكود
استبدال السطر التالى
 Do Until .Range("H11").Value = ""

وضع مكانه السطر التالى
Do Until .Range("E1").Value = FormulaR1C1 = "=MAX(ورقة2!RC[-7]:R[60]C[-7])"

ويعنى هذا السطر تنفيذ الكود لحين الوصول إلى أعلى رقم لجنة موجود فى ورقة العمل 2 والخاصة بتوريع اللجان وهو الرقم 12 بعدها سيتوقف الكود
----------------------
واتمنى من أخى الحبيب / ياسر أبو البراء ـ وضع لمساته الفنية  بأكواده البسيطة الغنية فى إكمال المطلوب للأخت السائلة





10-01-2018 12:56 صباحا
مشاهدة مشاركة منفردة [8]
زيزو العجوز
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 93
الجنس : ذكر
يتابعهم : 0
يتابعونه : 9
قوة السمعة : 712
الاعجاب : 168
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
السلام عليكم ورحمة الله
تحياتى لكل من شارك فى هذا الموضوع
اليكم كودين الاول لنسخ القوائم فارغة حسب عددها كما هى معدة فى الورقة  Main
اما الكود الثانى هو لاستدعاء بيانات التلاميذ الى قوائم اللجان
الكود الاول :
Sub AddLists()
Const S = 44
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim Arr As Variant
Dim Temp As Variant
Dim x As Integer, y As Integer, z As Integer
Dim LR As Long, n As Long, i As Long, j As Long, p As Long

Application.ScreenUpdating = False
Set Mn = Sheets("Main")
Set Dist = Sheets("ورقة2")
Set List = Sheets("Legan")
List.Range("D8") = 1
List.Range("I8") = 2
On Error Resume Next
List.Range("B47:J" & List.Range("H" & Rows.Count).End(xlUp).Row + 46).Clear
x = WorksheetFunction.Max(Dist.Range("E8:E" & Dist.Range("H" & Rows.Count).End(xlUp).Row))
If x Mod 2 = 1 Then
y = Int(x / 2)
Else
y = Int(x / 2) - 1
End If
z = y * S + 46
If y > 1 Then
List.Range("B3:J46").Copy
For n = 47 To z Step 44
List.Range("B" & n).PasteSpecial xlPasteAll
List.Range("D" & n + 5) = List.Range("D" & n - 39) + 2
List.Range("I" & n + 5) = List.Range("I" & n - 39) + 2

Next
End If
List.Range("B8").Select
Application.CutCopyMode = False

For n = 11 To z Step 44
List.Range("B" & n & ":J" & n + 29).ClearContents
List.Range("D" & n + 31 & ":E" & n + 33).ClearContents
List.Range("I" & n + 31 & ":J" & n + 33).ClearContents
Next

Application.ScreenUpdating = True

End Sub





الكود الثانى :
Sub FillLists()
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim LR As Long, n As Long, i As Long, p As Long, q As Long
Dim x, y, z
Dim xx, yy, zz
Set Mn = Sheets("Main")
Set Dist = Sheets("ورقة2")
Set List = Sheets("Legan")
LR = Mn.Range("D" & Rows.Count).End(xlUp).Row
For n = 8 To List.Range("D" & Rows.Count).End(xlUp).Row Step 44
For i = 8 To LR
If Mn.Cells(i, "S") = List.Cells(n, "D") Then
p = p + 1
List.Cells(p + n + 2, "C") = Mn.Cells(i, "D")
List.Cells(p + n + 2, "D") = Mn.Cells(i, "B")
List.Cells(p + n + 2, "E") = Mn.Cells(i, "G")
List.Cells(p + n + 2, "B") = p
x = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسلم" & "*")
y = WorksheetFunction.CountIf(List.Range("E" & n + 3 & ":E" & n + 32), "*" & "مسيحى" & "*")
List.Range("D" & n + 35) = x
List.Range("D" & n + 36) = y
List.Range("D" & n + 34) = x + y

End If
Next
p = 0
For i = 8 To LR
If Mn.Cells(i, "S") = List.Cells(n, "I") Then
q = q + 1
List.Cells(q + n + 2, "H") = Mn.Cells(i, "D")
List.Cells(q + n + 2, "I") = Mn.Cells(i, "B")
List.Cells(q + n + 2, "J") = Mn.Cells(i, "G")
List.Cells(q + n + 2, "G") = q
xx = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسلم" & "*")
yy = WorksheetFunction.CountIf(List.Range("J" & n + 3 & ":J" & n + 32), "*" & "مسيحى" & "*")
List.Range("I" & n + 35) = xx
List.Range("I" & n + 36) = yy
List.Range("I" & n + 34) = xx + yy

End If
Next
q = 0
Next
End Sub



هذا وبالله التوفيق

أثارت هذه المشاركة إعجاب: ناصر سعيد1، محمد الدسوقى،




10-01-2018 01:54 مساء
مشاهدة مشاركة منفردة [9]
Haneen Amr
menu_open
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 08-01-2018
رقم العضوية : 3478
المشاركات : 9
الجنس : أنثى
تاريخ الميلاد : 12-9-1976
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 17
الاعجاب : 2
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
الأستاذ الفاضل /  زيزو العجوز
بارك الله فيكم وجزاكم الله خيرا ونفع بكم دائما
أكواد رائعة بالفعل هذا ما كنت أبحث عنه
ولكن أرجو أن يتسع صدرك ووقتك لملحوظة بسيطة :
أرجو تعديل الأرقام الموجودة بالكود لتسمح بترك سطر تحت السطر الأخير ( رئيس الكنترول ـ النظام والمراقبة )
ليسمح بكتابة معادلة لسحب اسم رئيس الكنترول ـ والنظام و المراقبة ) من الصفحة الرئيسية ولتكن المعادلة مثلا : =Main!$D$2 

أنا حاولت كثيرا وعدلت فى الآرقام الموجودة بالكود الأول وفعلا تم النسخ تماما لكل اللجان
 ولكن واجهتنى مشكلة أن كل اللجان بعد نسخها تعطى قيمة واحدة بعد اللجنيتين الأوليتين
يعنى يكتب لجنة رقم 1 وبجوارها لجنة رقم 2 ثم بعد ذلك كل اللجان تحمل اسم لجنة رقم 2 ونفس الأسماء وأرقام الجلوس
فأرجو الافادة
واعتذر عن الاطالة ولكن وددت التوضيح أكثر 
 





10-01-2018 03:01 مساء
مشاهدة مشاركة منفردة [10]
محمد الدسوقى
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 47
المشاركات : 293
الجنس : ذكر
تاريخ الميلاد : 14-10-1973
الدعوات : 36
يتابعهم : 7
يتابعونه : 199
قوة السمعة : 2049
الاعجاب : 477
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
أستاذى الغالى / زيزو العجوز
بارك الله فيكم فعلا أكواد رائعة
زادك الله من علمه وعلمكم ما ينفعكم
-----------------------------
وإن كان عندى استفسار حول هذا الكود وهو
الكود يعمل على عدد محدد لكل لجنة وهوبعدد صفوف  القائمة المحددة فى الملف المرفق  بحد أقصى 30 طالب باللجنة الواحدة
ماذا إذا كان عدد اللجنة يزيد عن ذلك
فى هذه الحالة سيتم ترحيل البيانات الزائدة أسفل القائمة
فهل إلى ذلك من سبيل ؟؟؟؟؟
--------------------------
تقبل تحياتى أخى الكريم





10-01-2018 06:54 مساء
مشاهدة مشاركة منفردة [11]
زيزو العجوز
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 93
الجنس : ذكر
يتابعهم : 0
يتابعونه : 9
قوة السمعة : 712
الاعجاب : 168
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
السلام عليكم ورحمة الله
اليك الملف بعد ترك بعض الصفوف فارغة كى تضيف اليها ما تشاء

 
 
 
  لجان.rar   تحميل rar مرات التحميل :(10)
الحجم :(44.427) KB



تم تحرير المشاركة بواسطة :زيزو العجوز
بتاريخ:10-01-2018 06:54 مساء


أثارت هذه المشاركة إعجاب: تاج الدين،




10-01-2018 08:48 مساء
مشاهدة مشاركة منفردة [12]
ناصر سعيد1
menu_open
عضو ماسي
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-09-2017
رقم العضوية : 705
المشاركات : 422
الجنس : ذكر
تاريخ الميلاد : 2-2-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 433
الاعجاب : 162
 offline 
look/images/icons/i1.gif توزيع اللجان دفعة واحدة بالأكواد
استاذ زيزو
ربنا يبارك فيك
كودك رائع ونتمنى الاعتماد على الصفحه الرئيسيه Mainوصفحه اللجان فقط وازاله الاعتماد على صفحة ورقه 2







الكلمات الدلالية
توزيع ، اللجان ، دفعة ، واحدة ، بالأكواد ،


 







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

سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.




الساعة الآن 03:16 مساء

أعلن هنا
أعلن هنا
أعلن هنا