إخلاء طرف

[ابن عبدالرازق]

السلام عليكم ورحمة الله وبركاته

من فضلكم  اريد بعد اذنكم برنامج صغير اكسل 2003 ( اخلاء طرف ) لعدد من المدرسين من مدارس مختلفة فى لجنة امتحان واحدة  م    الاسم    المدرسة التابع لها    العمل المكلف به 1    2    3    4  ادارة المنيا التعليمية امتحان الشهادة الاعدادية الدور ا

اخلاء طرف.doc

[ابراهيم الحداد]

السلام عليكم ورحمة الله

ربما يفيدك هذا

 

اخلاء طرف.xls

[احمد بدره]

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

هل يمكن التعديل بحيث يظهر في كل ورقة 4 معلمين وشكرًا

[ابن عبدالرازق]

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اخى الكريم احمد

اشكرك على هذا الملحوطة الهامة

اليك الملف بعد التعديل

 

 

اخلاء طرف.xls

[احمد بدره]

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

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم الكود الاول فى موديول عادى

Sub PrintEW()
Dim R As Integer, ws As Worksheet
Set ws = Sheets("الاخلاء")
For R = 1 To ws.Range("O3").Value
R = Range("O2").Value
ActiveWindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate _
  :=True, IgnorePrintAreas:=False
   Range("O2").Value = R + 1
    Next R
End Sub

اما الكود الثانى فضعه فى حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$O$2" Then Exit Sub
Call EndWork
End Sub

 

 

 

 

[احمد بدره]

تسلم الأنامل  ولكن لي طلب ممكن شرح كود ماكرو EndWork حتى يتسثنى استعمالة في أشياء أخرى بالمصفوفات وليس بالمعادلات

[ابراهيم الحداد]

السلام عليكم ورحمة الله

اخى الكريم اليك شرح الكود

و الله الموفق و المستعان

 ' وقف اهتزاز الشاشة اثناء تنفيذ الماكرو
Application.ScreenUpdating = False
 ' تعريف الورقة الهدف
Set ws = Sheets("الاخلاء")
 ' التعريف بورقة المصدر
Set Sh = Sheets("المدرسين")
 ' طول البيانات فى ورقة المصر ( آخر صف )
LR = Sh.Range("C" & Rows.Count).End(xlUp).Row
 ' رقم الكشف المراد استدعاؤه
z = ws.Range("O2").Value
  ' اهم نقطة فى الكود تم البدء برقم سالب حتى نتمكن من البدء يالصف الثامن
j = -4
  ' لتحديد اول رقم يتم جلبه
x = (z - 1) * 4 + 1
  ' تحديد آخر رقم يتم جلبه
y = z * 4
  ' حلقة تكرارية تبدأ من الصف الرابع للبيانات التى سوف يتم جلبها
For i = 4 To LR
  ' شرط استدعاء البيانات بالارقام المحصورة بينها
If Sh.Cells(i, "B") >= x And Sh.Cells(i, "B") <= y Then
  ' تسلسل البيانات المستدعاة بورقة الهدف
j = j + 12
   ' تسكين البيانات فى المواضع المطلوبة
ws.Cells(j, "E") = Sh.Cells(i, "D")
ws.Cells(j, "J") = Sh.Cells(i, "C")
ws.Cells(j + 1, "E") = Sh.Cells(i, "E")
End If
Next i
  ' اعادة خاصية اهتزازات الشاشة
Application.ScreenUpdating = True

 

 

 

 

[احمد بدره]

أشكرك أخى الفاضل  الأستاذ / زيزو  زادك الله علمًا جعله الله في ميزان حسناتك

[ابن عبدالرازق]