الشهادات المدرسية ج2

يتبقي لنا جزئيتين فى غاية الأهمية 

الأولي : الكود البرمجى أو الماكرو الذى سيقوم بتنفيذ ذلك 

الثانية : كيفية اظهار نتيجة طالب ما أو عدد معين من الطلاب سواء ناجحين أم راسبين طبعا مع الاختيار من القائمة المنسدلة 

          للفصل الدراسي 

الأولي :

           كل ما عليك هو نسخ ولصق الأكواد التالية ووضعها داخل موديول 

الخطوات كالتالي :-

1 - قم بالدخول إلى محرر الأكواد بالضغط على زرين ( ALT + F11 ) 

2 - قم بالضغط كليك يمين على يسار الشاشة التى أمامك 

3 - ستظهر نافذة اختر منها انشاء موديول جديد
4 - قم بنسخ ولصق الأكواد التالية داخل الموديول 

'     بدء الكود بتحديد النطاقات الثابة
'      const  تستخدم لتحديد الثوابت
'     اسم ورقة الشهادات
Const ShName As String = "Certificates"
'     رقم اول صف للشهادة
Const FirstRow As Integer = 6
'     عدد صفوف الشهادة
Const CountRow As Integer = 17
'عدد اعمدة الشهادة التي تريد اظهارها في الطباعة
Const CountColumn As Integer = 17
' خلية موقع الطالب  لمعادلات الشهادة
Const Range_Index As String = "A6"
'     اسم ورقة قاعدةالبيانات
Const Sh As String = "Data"
' نطاق الاسماء في ورقة قاعدةالبيانات
Const MyNSearch As String = "C5:S44"
'     عمود نتيجة الفصل الدراسي الأول بورقة قاعدةالبيانات
Const MyND As String = "L5:L44"
'     عمود نتيجة الفصل الدراسي الثاني بورقة قاعدةالبيانات
Const MyLE As String = "S5:S44"
'   الخلية التى بها عدد كل الطلاب تجدها بشيت الشهادة
Const CountAll As String = "E1"
'     الخلية التى بها عدد الطلاب الناجحين للفصل الدراسي الأول بشيت الشهادة
Const CountNA As String = "E2"
'     الخلية التى بها عدد الطلاب الناجحين للفصل الدراسي الثاني بشيت الشهادة
Const CountME As String = "P2"
Const NA_G As String = "ناجح"
'     الخلية التى بها عدد الطلاب الراسبين للفصل الدراسي الأول بشيت الشهادة
Const CountDT As String = "E3"
'     الخلية التى بها عدد الطلاب الراسبين للفصل الدراسي الثاني بشيت الشهادة
Const CountEA As String = "P3"
Const DT_G As String = "راسب"
'     متغيرين نعلن عنهم
Dim MZM_Test As Boolean
Dim MySheet As Worksheet
Sub MZM_ALL()
'     إيقاف تحديث الشاشة
Application.ScreenUpdating = False
'     استدعاء كود مسح النطاق تجهيزا لاستقبال بيانات جديدة
MZM_ClearContents
With MySheet
'     اسم النطاق الثابت المعلن عنه سابقا (Range_Index)خلية موقع الطالب لمعادلات الشهادة
    .Range(Range_Index).Value = 1
    '      استدعاء عمل الكود التالى مع الأخذ فى الاعتبار الثابت الذى قمنا بتعريفة وهى الخلية التى بها عدد اجمالى الطلاب
    Call MZM_Test_Fill(.Range(CountAll))
    '   اذا كان المتغير المعلن عنه بأول الكود به بيانات بناء على خلية معادله الشهادة تم تنفيذ المطلوب مع استدعاء الكود بالسطر السابق اذن يتم تطبيق التالي
    '     يتم مسح النطاق للكتابه فيه مع عرض الطباعة
    If MZM_Test Then .PrintPreview Else .Range(Range_Index).ClearContents
End With
'     اعادة تحديث الشاشة
Application.ScreenUpdating = True
End Sub
Sub MZM_Delete()
'     إيقاف تحديث الشاشة
Application.ScreenUpdating = False
'     استدعاء كود مسح النطاق
MZM_ClearContents
'     اعادة تحديث الشاشة
Application.ScreenUpdating = True
'    حفظ العمل واظهار رسالة تفيد ذلك
ThisWorkbook.Save
MsgBox "تم مسح الشهادات وحفظ نطاق عمل الشهادة الرئيسية", vbMsgBoxRight, "الحمد لله الذى بنعمته تتم الصالحات"
End Sub
Sub MZM_ClearContents()
'   متغير نعلن عنه
Dim T As Long
'     تخصيص متغير أعلن عنه سابقا
Set MySheet = Sheets(ShName)
With MySheet
'  خلية موقع الطالب  لمعادلات الشهادة وهو من الثوابت المعلن عنها سابقا يتم المسح مع الحفاظ على النموذج ( الشهادة الرئيسية) الذى يستخدم للنسخ كما هو
   .Range(Range_Index).ClearContents
    T = .UsedRange.Rows.Count
    .Rows(FirstRow + CountRow).Resize(T).Delete
    '     نطلب منه الوقوف على الخلية التى تم الاعلان عنها كثابت وهى خلية موقع الطالب لمعادلات الشهادة
     Application.GoTo .Range(Range_Index), True
End With
End Sub
Sub MZM_Test_Fill(MyCel As Range)
If IsNumeric(MyCel) And MyCel.Value > 0 Then
    MZM_Test = True
    If MyCel.Value <> 1 Then Call MZM_AutoFill(MyCel.Value)
Else
    MZM_Test = False
    MsgBox MyCel.Offset(0, -1) & Chr(10) & Chr(10) & MyCel, 524288 + 1048576 + 16, "بيانات غير متوفرة"
End If
End Sub
Sub MZM_AutoFill(R As Integer)
Dim SourceRange As Range, fillRange As Range
Dim RR As Long
RR = (R * CountRow)
With MySheet
    Set SourceRange = .Rows(FirstRow).Resize(CountRow)
    Set fillRange = .Rows(FirstRow).Resize(RR)
    SourceRange.AutoFill fillRange, xlFillDefault
    .PageSetup.PrintArea = .Range("B" & FirstRow).Resize(RR, CountColumn).Address
End With
End Sub
Sub ناجح_نصف()
Application.ScreenUpdating = False
MZM_ClearContents
With MySheet
    Call MZM_Test_Fill(.Range(CountNA))
    If MZM_Test Then Call MZM_JJJ(NA_G): .PrintPreview
End With
Application.ScreenUpdating = True
End Sub
Sub راسب_نصف()
Application.ScreenUpdating = False
MZM_ClearContents
With MySheet
    Call MZM_Test_Fill(.Range(CountDT))
    If MZM_Test Then Call MZM_JJJ(DT_G): .PrintPreview
End With
Application.ScreenUpdating = True
End Sub
Sub ناجح_آخر()
Application.ScreenUpdating = False
MZM_ClearContents
With MySheet
    Call MZM_Test_Fill(.Range(CountME))
    If MZM_Test Then Call MZM_EL(NA_G): .PrintPreview
End With
Application.ScreenUpdating = True
End Sub
Sub راسب_آخر()
Application.ScreenUpdating = False
MZM_ClearContents
With MySheet
    Call MZM_Test_Fill(.Range(CountEA))
    If MZM_Test Then Call MZM_EL(DT_G): .PrintPreview
End With
Application.ScreenUpdating = True
End Sub
Sub MZM_JJJ(Nd As String)
Dim MyRng As Range
Dim R As Integer, C As Integer, RR As Long
Set MyRng = Sheets(Sh).Range(MyND)
With MySheet
    RR = .Range(Range_Index).Row
    C = .Range(Range_Index).Column
End With
With MyRng
    For R = 1 To .Rows.Count
        If .Cells(R, 1) = Nd Then
            MySheet.Cells(RR, C) = R
            RR = RR + CountRow
        End If
    Next
End With
End Sub
Sub MZM_EL(Nd As String)
Dim MyRng As Range
Dim R As Integer, C As Integer, RR As Long
Set MyRng = Sheets(Sh).Range(MyLE)
With MySheet
    RR = .Range(Range_Index).Row
    C = .Range(Range_Index).Column
End With
With MyRng
    For R = 1 To .Rows.Count
        If .Cells(R, 1) = Nd Then
            MySheet.Cells(RR, C) = R
            RR = RR + CountRow
        End If
    Next
End With
End Sub

5 - قم بإنشاء عدد ( 6 ) أزرار بشيت الشهادة لكى تقوم بربطهم بالكود المخصص بها كما بالصورة التالية 

6 - قم بربط الزر الخاص بـ ( طباعة الكل ) بالكود المسمى ( MZM_ALL )

7 - قم بربط الزر الخاص بـ ( مسح الشهادات ) بالكود المسمى ( MZM_Delete )

8 - قم بربط الزر الخاص بـ ( طباعة ناجح نصف العام ) بالكود المسمى ( ناجح_نصف )

9 - قم بربط الزر الخاص بـ ( طباعة راسب نصف العام ) بالكود المسمى ( راسب_نصف )

10 - قم بربط الزر الخاص بـ ( طباعة ناجح آخر العام ) بالكود المسمى ( ناجح_آخر )

11 - قم بربط الزر الخاص بـ ( طباعة راسب آخر العام ) بالكود المسمى ( راسب_آخر )

تلميح :-

كيفية ربط الزر بالكود بعد ادراج أى شكل وتنسيقه والكتابه عليه يتم الضغط عليه كليك يمين تظهر قائمة اختر منها 

( Assign Macro ) ، ستظهر لك نافذة اختر منها اسم الكود 

الثانية :

وهى عملية البحث عن نتيجة طالب أو عدد معين بالطلاب
وسنلجأ إلى إستخدام Userform ( يوزرفورم أو فورم )
لكى تسهل عملية البحث واستخراج النتائج المطلوبة بسهولة

الخطوات كالتالي :-

1 - قم بالدخول إلى محرر الأكواد مرة أخري
2 - بالضغط كليك يمين على يسار شاشة محرر الأكواد تظهر قائمة اختر ادراج Userform
     ثم قم بتغيير اسم الـ Userform إلى form_Search
     وذلك من خلال خصائص الـ Userform

مكونات الـ Userform

كما بالصورة التالية :
# عدد ( 2 ) Label
   تم تسميتهم من خلال الخصائص كالتالي :
   * Label 1
   * Mzm_Label 2

# عدد ( 1 ) Textbox
   تم تسمية التكست كالتالي :
    * CM_TextFind

# عدد ( 2 ) ListBox
   تم تسميتهم كالتالي :
   * CM_ListFind
   * CM_ListAdd

# عدد ( 3 )  CommandButton
   تم تسميتهم كالتالي :

3 - بالضغط كليك يمين على الـ Userform سندخل الى محرر الاكواد الخاص بها
4 - قم بمسح أى سطور برمجية تجدها
5 - قم بنسخ ولصق الأكواد التالية

Dim MyRng As Range
Private Sub Mzm_Label2_Click()
Dim N As Integer, NN As Integer
N = CM_ListFind.ListIndex
NN = CM_ListAdd.ListCount
With CM_ListAdd
    .AddItem
    .List(NN, 0) = CM_ListFind.List(N, 0)
    .List(NN, 1) = CM_ListFind.List(N, 1)
End With
Mzm_Button1.Enabled = True
End Sub
Private Sub Mzm_Button2_Click()
CM_ListAdd.Clear
Mzm_Button1.Enabled = False
End Sub
Private Sub Mzm_Button3_Click()
Unload Me
End Sub
Private Sub CM_ListFind_Change()
With CM_ListFind
    If .ListIndex <> -1 Then Mzm_Label2.Enabled = True Else Mzm_Label2.Enabled = False
End With
End Sub
Private Sub CM_TextFind_Change()
Dim Mycell As Range
Dim T As Integer
CM_ListFind.Clear
For Each Mycell In MyRng
    If Mycell = "" Then GoTo 1
    If Mycell Like "*" & CM_TextFind.Text & "*" Then
        With CM_ListFind
            .AddItem
            .List(T, 0) = Mycell.Value
            .List(T, 1) = Mycell.Row - MyRng.Row + 1
            T = T + 1
        End With
    End If
1
Next Mycell
End Sub
Private Sub Mzm_Button1_Click()
Me.Hide
Item_Search
End Sub
Private Sub UserForm_Activate()
Set MyRng = Sheets(Me.Tag).Range(CM_TextFind.Tag)
CM_TextFind_Change
End Sub

6 - قم بإضافة موديول جديد 

7 - قم بنسخ ولصق الكودين التاليين به 

Sub معاينة()
Sheet2.PrintPreview
End Sub

Sub Mzm_Search()
Load form_Search
With form_Search
    .Tag = Sh
    .CM_TextFind.Tag = MyNSearch
    .Show
End With
End Sub

8 - قم بإنشاء زرين بشيت الشهادة 

     أحدهم بإسم ( البحث ) وقم بربطه بالكود المسمي ( Mzm_Search )

     والثاني بإسم ( معاينة ) وقم بربطه بالكود المسمى ( معاينة )

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

يرجي الإشتراك بالقائمة البريدية 

ثم إرسل طلبك عبر اتصل بنا

موضحا النموذج الذى ترغب به  علما بأنها مجانية