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

إخواني وأحبابي في الله ..
بدايةً الدرس للمستوى المتقدم وفوق المتوسط في الـ VBA ... أحببت أن أنوه قبل البدء

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

بدأت بالفورم بزر الاختيار الخاص بمادة اللغة العربية OptionButton1 ووجدت الكود التالي

Private Sub OptionButton1_Click()
    ActiveSheet.Range("D3").Value = Subjects.ComboBox1.Text
    Test_A
    ActiveSheet.Range("F3").Value = "اللغة العربية"
    Me.OptionButton1.Value = False
End Sub

حيث يقوم الكود بوضع قيمة الكومبوبوكس في الخلية D3 ويضع اسم المادة في الخلية F3 ويستدعي إجراء آخر باسم Test_A
وعند الإطلاع على الإجراء وجدت أنه اعتمد على جلب البيانات باستخدام المصفوفات حيث وضع شرط الفصل في الكود فيتم جلب بيانات هذا الفصل فقط في هذه المادة ، حيث استخدم مصفوفة بالأعمدة المطلوب جلبها فقط وهي الأعمدة 2 و 5 و 6
وكرر الأخ الحبيب محمد الدسوقي نفس الأكواد لجميع المواد بنفس الأسلوب مع تغيير أرقام الأعمدة فقط ، وهذا حل رائع بكل المقاييس

>>> لما رأيت أن الأكواد متشابهة تماماً ما عدا في الأعمدة المطلوب جلبها قررت أن أقوم بعمل إجراء عام Public Procedure ويكون المتغير فيه هو المصفوفة الأحادية التي تحتوي على أرقام الأعمدة المطلوبة
فقمت بنسخ الكود مع تعديل الكود أو الإجراء العام ليصبح مرن ويمكن استخدامه أكثر من مرة (وهذه من فوائد استخدامات الإجراءات العامة) حيث يمكنك اختصار الأكواد المتشابهة في إجراء واحد ثم تستدعي الإجراء العام بسطر واحد من الأكواد





وإليكم الإجراء العام الذي سيستخدم عدة مرات

Sub FetchBySubject(x As Variant)
    Dim ws          As Worksheet
    Dim sh          As Worksheet
    Dim a           As Variant
    Dim b           As Variant
    Dim m           As Long
    Dim i           As Long
    Dim j           As Long
    Dim p           As Long

    Set ws = ThisWorkbook.Sheets("Data")
    Set sh = ThisWorkbook.Sheets("Output")

    m = ws.Cells(Rows.Count, 2).End(xlUp).Row
    sh.Range("C5:E34").ClearContents
    a = ws.Range("A7:AB" & m).Value
    ReDim b(1 To UBound(a, 1) + 1, 0 To UBound(x) + 1)

    For i = 1 To UBound(a)
        If a(i, 4) = sh.Range("D3").Value Then
            p = p + 1
            For j = 0 To UBound(x)
                b(p, j) = a(i, x(j))
            Next j
        End If
    Next i

    Application.ScreenUpdating = False
        If p > 0 Then sh.Range("C5").Resize(p, UBound(b, 2)).Value = b
    Application.ScreenUpdating = True
End Sub

في الإجراء العام المتغير x سيشير للمصفوفة الأحادية ، أي مصفوفة أرقام الأعمدة المطلوب جلبها والتعامل معها

** ملحوظة قمت بتغيير أسماء ورقة العمل في الملف الأصلي إلى Data و Output



>> يوضع في الموديول العادي كود لإظهار الفورم بهذا الشكل (مستوى مبتديء)

Sub ShowForm()<br />
&nbsp; &nbsp; Subjects.Show<br />
End Sub<br />

الآن انتهينا من الإجراء العام ...........
=====================================================================
الآن عند انتقالي لأزرار الاختيار وجدت أنه سيكون بنفس النمط والشكل أيضاً ( حيث يوجد 8 أزرار اختيار وسيقوم الكود عند النقر على أي زر من هذه الأرزار بتعبئة الخلايا D3 و F3 ثم استدعاء الإجراء العام ، ومن هنا أتت فكرة أخرى ، وهي للمستوى المتقدم ..
الفكرة تعتمد على أن الأحداث المطلوب التعامل معها واحدة وهو الحدث Click ، وأزرار التحكم المطلوب التعامل معها واحدة وهي Option Buttons
ومن ثم تأتي فكرة إنشاء Class Module >> ولتقريب الصورة للأذهان : هذا بمثابة عمل وإنشاء قالب جاهز أو قالب متشابه ، والذي يمكن الاستفادة منه في عدم تكرار الأحداث على أزرار التحكم (قد يبدو الكلام غير مفهوم .. لكن بالمثال يتضح المقال)

>> قم بإنشاء Class Module عن طريق كليك يمين في نافذة المشروع ثم اختر Insert ثم Class Module
قم بتمسية الـ Class Module باسم clsOptionButton بهذا الشكل


دبل كليك على الـ Class Module وأدخل الكود التالي

Public WithEvents myOptionButton As MSForms.OptionButton
Public x As Variant

Private Sub myOptionButton_Click()
    ActiveSheet.Range("D3").Value = Subjects.ComboBox1.Text
    ActiveSheet.Range("F3").Value = myOptionButton.Caption

    Select Case myOptionButton.Name
        Case "OptionButton1": x = Array(2, 5, 6)
        Case "OptionButton2": x = Array(2, 8, 9)
        Case "OptionButton3": x = Array(2, 11, 12)
        Case "OptionButton4": x = Array(2, 14, 15)
        Case "OptionButton5": x = Array(2, 17, 18)
        Case "OptionButton6": x = Array(2, 20, 21)
        Case "OptionButton7": x = Array(2, 23, 24)
        Case "OptionButton8": x = Array(2, 26, 27)
    End Select

    FetchBySubject x
End Sub

ماذا يفعل الكود هنا؟
الكود سوف يغنيك عن التعامل مع أزرار الاختيار من خلال الفورم ، بل سيتم التعامل معه من خلال الـ Class Module ...
هنا يتم وضع اسم الفصل الموجود في فورم Subjects في الخلية D3
ويتم وضع اسم المادة بناءً على عنوان الـ Option Button
ثم يأتي الجزء الأهم وهو استخدام جملة Select Case
حيث يتم اختبار اسم زر الاختيار Option Button ، فإذا كان الاسم هو OptionButton1 يتم تخزين مصفوفة أحادية باسم x لأرقام الأعمدة 2 و 5 و 6 ..... وهكذا مع بقية أزرار الاختيار

==================================================================
آخر نقطة وهو الفورم ، نذهب للفورم المسمى Subjects ثم نضع الكود التالي في حدث بدء تشغيل الفورم

Private arrOptionButtons() As New clsOptionButton

Private Sub UserForm_Initialize()
    Dim ctl         As Control
    Dim n           As Long

    For Each ctl In Me.Controls
        If TypeName(ctl) = "OptionButton" Then
            n = n + 1
            ReDim Preserve arrOptionButtons(1 To n)
            Set arrOptionButtons(n).myOptionButton = ctl
        End If
    Next ctl
End Sub

Private Sub UserForm_Terminate()
    Erase arrOptionButtons
End Sub

يتم الإعلان عن مصفوفة من النوع الجديد للـ Class Module ... بهذا الشكل

Private arrOptionButtons() As New clsOptionButton<br />

حيث مع بدء تشغيل الفورم نقوم بتخزين أدوات التحكم المطلوب التعامل معها ، وأدوات التحكم المعنية هنا هي أزرار الاختيار

الآن وقد وصلنا للمحطة الأخيرة إذا قمنا بتشغيل الفورم واختيار الفصل من الكومبوبوكس ثم النقر على أي زر اختيار من الأزرار الموجودة في الفورم سيتم التعامل مع زر الاختيار بشكل منفصل بنفس الكود المستخدم في الـ Class Module

** ملحوظة : تم تغيير اسم أزرار الاختيار لمادتي "التربية الفنية" و"الحاسب الآلي" ...

تحميل الملف المرفق من هنا
أرجو أن تكونوا قد استفدتم من الموضوع ...
لا تنسونا بصالح دعائكم

أخوكم في الله / ياسر خليل أبو البراء