تعبئة جدول المعلمين اوتوماتيكياً معتمدا ً على جدول الدروس الاسبوع

[عامر ياسر]

السلام عليكم .... الشرح داخل الملف

تعبئة جدول المعلمين اوتوماتيكياً معتمدا ً على جدول الدروس الاسبوع.rar

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم عامر

حاول أن تضع شرح للمطلوب داخل الموضوع قبل الملف المرفق لتتضح الصورة لمن أراد تقديم المساعدة قبل الإطلاع على الملف ..بلاش كسل يا عامر يا عسل

 

ضع الكود التالي في موديول عادي (اذهب لمحرر الأكواد Alt + F11 ثم من قائمة Insert أدرج موديول جديد من خلال الأمرModule) ثم ضع الكود التالي فيه

Sub Teacher_Table()
    Dim Ws          As Worksheet
    Dim Sh          As Worksheet
    Dim strTeacher  As String
    Dim iRow        As Long
    Dim iCol        As Long
    Dim Col         As Long
    Dim Row         As Long
    
    Set Ws = Sheet1
    Set Sh = Sheet2
    strTeacher = Sh.Range("E4").Value

    Application.ScreenUpdating = False
        Sh.Range("C7:G18").ClearContents
        
        For iRow = 8 To 37
            For iCol = 4 To 30 Step 2
                If Ws.Cells(iRow, iCol).Value = strTeacher Then
    
                    On Error Resume Next
                    Col = Application.Match(myDay(iRow), Sh.Range("C6:G6"), 0)
                    Row = Application.Match(Ws.Cells(iRow, 2).Value, Sh.Range("A7:A18"), 0)
    
                    If IsNumeric(Col) And IsNumeric(Row) Then
                        Sh.Cells(Row + 6, Col + 2).Value = Ws.Cells(6, iCol - 1).Value
                        Sh.Cells(Row + 7, Col + 2).Value = Ws.Cells(iRow, iCol).Offset(0, -1).Value
                    End If
                End If
            Next iCol
        Next iRow
    Application.ScreenUpdating = True
End Sub

Function myDay(X As Long) As String
    Select Case X
    Case 8 To 13
        myDay = "الاحد"
    Case 14 To 19
        myDay = "الاثنين"
    Case 20 To 25
        myDay = "الثلاثاء"
    Case 26 To 31
        myDay = "الأربعاء"
    Case 32 To 37
        myDay = "الخميس"
    End Select
End Function

ثم ضع الكود التالي في حدث ورقة العمل المسماة "جدول المعلمين" .. كليك يمين على اسم ورقة العمل ثم View Code ثم الصق الكود التالي

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$E$4" Then
        Call Teacher_Table
    End If
End Sub

وأخيراً اذهب لورقة العمل واختر اسم المعلم من الخلية E4 لتشاهد جدول المعلم ..

لا تنسانا بدعوة بظهر الغيب

تقبل تحياتي

[عامر ياسر]

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

ولو امكن وانت اهل لذلك وضع الكود داخل الملف ...... وهذا ليس كسلا ً ولكن اختصارا للوقت ومنكم نتعلم وقد قدم لي هذا المنتدى الكثير من الحلول والمساعدات التي تسهل لي العمل دعائي لك استاذي الكريم  بدوام العافية و التوفيق و النجاح

[ياسر خليل أبو البراء]

أخي الكريم عامر

لن أوفر عليك الوقت والجهد (عشان مش بحب الكسل .. وعشان تتعلم الأمور الأساسية التي لابد منها)

اطلع على الصورة المرفقة وستعرف سبب المشكلة لديك

 

[عامر ياسر]

5 دقائق مضت, ياسر خليل أبو البراء said:

أخي الكريم عامر

لن أوفر عليك الوقت والجهد (عشان مش بحب الكسل .. وعشان تتعلم الأمور الأساسية التي لابد منها)

اطلع على الصورة المرفقة وستعرف سبب المشكلة لديك

 

انت مبدع تحياتي واعجابي لحضرتكم وعذرا لجهلي ............منكم نتعلم ... الف الف الف الف شكر ... الف الف الف الف شكر ... الف الف الف الف شكر ... الف الف الف الف شكر ... الف الف الف الف شكر  .... وهذا هو المطلوب والملف يعمل بشكل جيد .... انت عسل 

[ياسر خليل أبو البراء]

الحمد لله الذي بنعمته تتم الصالحات .. كل الفضل يرجع لله عزوجل فقط وما أنا إلا سبب في حل مشكلتك

جمعني الله وإياك في الفردوس الأعلى ..

تقبل وافر تقديري واحترامي