ملف للاستاذ محمود الشريف

[ناصر سعيد]

لاساتذه المنتدى وعمالقته ربنا يبارك فيكم

هذا ملف للاستاذ المحترم محمود الشريف

يستخرج به الناجحين والراسبين

ولكن بمعيار كلمه واحده مثلا ناجح ....

ويوجد ناجح وناجحه

او راسب وراسبه

كيف يمكن تعديل هذه الجزئيه في الكود  ؟

 

طباعة شهادات.rar

طباعة شهادات.rar

[عبدالجيد]

شكرا على ماقدمته وجزاك الله خيرا

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

السلام عليكم أخي الكريم ناصر

ابحث عن الإجراء الفرعي المسمى 

Sub Kh_JJJ(Nd As String)

وعدل السطر التالي

If .Cells(R, 1) = Nd Then

ليكون بالشكل التالي

If .Cells(R, 1) Like "*" & Nd & "*" Then

 

[ناصر سعيد]

الان ارفع لك القبعه ..

جزاك الله كل خير وبارك لك استاذ ياسر خليل

اكمل جميلك في جزئيه اخرى

تعجبني بدايه هذا الكود

بمعنى انه يضع كل المتغيرات في اول الكود

اتعشم منكم ان تجعل هذا الكود في الملف المرفق في هذه المشاركه ان يتميز بهذه الميزه ( ان تكون المتغيرات في اول الكود )

 

 

شهادات رائعه لساجدة.rar

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

وجزيت خيراً أخي الكريم ناصر

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

مثال: 

لو أن لديك النطاق A1:B6 ومستخدم في الكود أكثر من مرة فيمكن ببساطة وضع سطر بهذا الشكل في بداية الكود

Const strRange As String="A1:B6"

ثم استخدم المتغير المسمى strRange (يمكن تسميته بما شئت ..) يمكن استخدامه في أي سطر موجود فيه النطاق 

على سبيل المثال : 

Sheets("Sheet1").Range("A1:B6").ClearContents

سيكون بهذا الشكل بعد إضافة السطر الأول

Sheets("Sheet1").Range(strRange).ClearContents

لاحظ أنه تم استبدال النطاق A1:B6 بالمتغير الثابت

 

وهكذا لأي متغير لديك ...

[ناصر سعيد]

اولا جزاك الله خيرا وبارك فيك الاستاذ ياسر خليل

الكود الذي اقصده هو الكود الاول الخاص بالناجحين 

وعلى منواله ساغير الاكواد الاخرى

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

جزيت خيراً أخي الكريم ناصر بمثل ما دعوت لي 

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

 

[ناصر سعيد]

ربنا يبارك لك استاذ ياسر خليل

==

الفيديو لايعمل

في المشاركه الاولى هل يمكن طباعه الشهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول

 

ربنا يبارك لك استاذ ياسر خليل

==

الفيديو لايعمل

في المشاركه الاولى هل يمكن طباعه الشهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول

 

[ناصر سعيد]

الفيديو يعمل .. جزاك الله كل خير استاذ ياسر خليل

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

بارك الله فيك أخي الكريم ناصر

ممكن توضيح للمطلوب بخصوص "شهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول" 

 

[ناصر سعيد]

الاستاذ المحترم ياسر خليل

جزاك الله الف الف خير

نحن عندما نضغط على زر الناجحين تظهر الشهادات بشرط ان يكونو ناجحين

وعندما نضغط على زر الدور التاني تظهر الشهادات ولكن بشرط ان يكونوا لهم دور تان

طيب عايزين الشهادات تطلع بشرط الفصول يعني عايز شهادات فصل 5/1 مثلا وهكذا

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

أعتقد أن الأستاذ محمد صالح قدم حل لهذه الإشكالية على ما أذكر .. ألم يفي الحل بالغرض ...؟

[ناصر سعيد]

لا يا اخي لايوجد حل لهذا الكود حتى الان

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

جرب الكود التالي .... 

Sub كل_الناجحين()
    Const StudentData As String = "رصد الترم الثانى"
    Const Shehada As String = "شهادة"

    lr = Sheets(StudentData).Range("C7").End(xlDown).Row
    c = 2
    
    Application.ScreenUpdating = False
        x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel)
        If x = vbYes Then
            b = True
        ElseIf x = vbNo Then
            b = False
            strClass = InputBox("أدخل الفصل")
            If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then
                MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub
            End If
        Else
            MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub
        End If
    
        For i = 7 To lr
            If c Mod 2 = 0 Then
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                End If
                GoTo 1
            Else
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                    Sheets(Shehada).Range("A1:P31").PrintOut
    
                    Sheets(Shehada).Cells(3, 13) = ""
                    Sheets(Shehada).Cells(19, 13) = ""
                End If
            End If
1:
        Next i
        If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then
            Sheets(Shehada).Range("A1:P15").PrintOut
        End If
    Application.ScreenUpdating = True
End Sub

 

[ناصر سعيد]

ربنا يبارك لك استاذ ياسر خليل

لوفيه خليه وفيها قائمه منسدله بالفصول .. هاتكون اسهل من الكتابه لتطابق اسم الفصل في القائمه المنسدله

ربنا يكتبها في كفة حسناتك

 

[ناصر سعيد]

10 ساعات مضت, ياسر خليل أبو البراء said:

MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر",

جزاك الله كل خير وبارك فيك استاذ ياسر خليل

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

قم بتصميم قائمة منسدلة بالفصول وجعل قيمة المتغير strClass تساوي تلك الخلية ولكن في تلك الحالة لن يكون ثابت Const بل يجب تغييره ليكون متغير بهذا الشكل

Dim strClass as String

strClass=Range("J6").Value

باعتبار أن الخلية J6 ستحتوي على القائمة المنسدلة

تقبل تحياتي

[ناصر سعيد]

Sub فصـــول_1()
    Const StudentData As String = "رصد الترم الثانى"
    Const Shehada As String = "شهادة"
Dim strClass As String

strClass = Range("W2").Value
    lr = Sheets(StudentData).Range("C7").End(xlDown).Row
    c = 2
    
    Application.ScreenUpdating = False
        x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel)
        If x = vbYes Then
            b = True
        ElseIf x = vbNo Then
            b = False
          '  strClass = InputBox("أدخل الفصل")
            If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then
                MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub
            End If
        Else
            MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub
        End If
    
        For i = 7 To lr
            If c Mod 2 = 0 Then
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                End If
                GoTo 1
            Else
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                    Sheets(Shehada).Range("A1:P31").PrintOut
    
                    Sheets(Shehada).Cells(3, 13) = ""
                    Sheets(Shehada).Cells(19, 13) = ""
                End If
            End If
1:
        Next i
        If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then
            Sheets(Shehada).Range("A1:P15").PrintOut
        End If
    Application.ScreenUpdating = True
End Sub

هل يكون بهذا الشكل يا استاذ ياسر حفظك الله ؟

لانها لم تعمل معي معذره

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

الكود بهذا الشكل سليم إن شاء الله

ولكن طالما أننا سنتعامل مع أكثر من ورقة عمل فلابد من الإشارة لورقة العمل التي فيها قيمة الخلية (القائمة المنسدلة)

قم بالإشارة إلى ورقة العمل قبل كلمة Range في هذا السطر

strClass = Sheets(StudentData).Range("W2").Value

 

[ناصر سعيد]

Sub فصـــول_1()
    Const StudentData As String = "رصد الترم الثانى"
    Const Shehada As String = "شهادة"
Dim strClass As String
strClass = Sheets(Shehada).Range("W2").Value

    lr = Sheets(StudentData).Range("C7").End(xlDown).Row
    c = 2
    
    Application.ScreenUpdating = False
        x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel)
        If x = vbYes Then
            b = True
        ElseIf x = vbNo Then
            b = False
          '  strClass = InputBox("أدخل الفصل")
           ' If IsError(Application.Match(strClass, Sheets(StudentData).Columns(4), 0)) Or strClass = "" Then
             '   MsgBox "لا يوجد فصل لديك بهذا الشكل", vbExclamation: Exit Sub
          '  End If
       ' Else
         '   MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub
        End If
    
        For i = 7 To lr
            If c Mod 2 = 0 Then
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(3, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(12, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(12, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                End If
                GoTo 1
            Else
                If Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*" And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then
                    Sheets(Shehada).Cells(19, 13) = Sheets(StudentData).Cells(i, 2)
                    Sheets(Shehada).Cells(28, 3) = Sheets(StudentData).Cells(i, 157)
                    Sheets(Shehada).Cells(28, 6) = Sheets(StudentData).Cells(i, 158)
                    c = c + 1
                    Sheets(Shehada).Range("A1:P31").PrintOut
    
                    Sheets(Shehada).Cells(3, 13) = ""
                    Sheets(Shehada).Cells(19, 13) = ""
                End If
            End If
1:
        Next i
        If Sheets(Shehada).Cells(19, 13) = "" And Sheets(Shehada).Cells(3, 13) <> "" Then
            Sheets(Shehada).Range("A1:P15").PrintOut
        End If
    Application.ScreenUpdating = True
End Sub

جزاك الله الف الف خير  استاذ ياسر

تاتي باناجحين الفصل فقط اذا اخترنا لا

اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان )

=====

نريدها اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان )

 

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

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

If IIf(b = True, Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*", True) And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then

ستقوم بتغيير السطرين بنفس الأسلوب وجرب وأخبرني بالنتائج

[ناصر سعيد]

اخي الكريم استاذ ياسر خليل

جزاك الله الف الف خير وبارك فيك

السطرين لم يؤدو الغرض

====

في شهادات الفصول خرجت شهادات الناجحين من الفصل فقط

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

سأحاول تجربة الكود مرة أخرى في أقرب وقت إن شاء الله

[ناصر سعيد]

جزاك الله كل خير وبارك لك استاذ ياسر خليل

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

أخي الكريم ناصر جرب الكود التالي
 

Sub PrintClassesYK()
    Dim wshD            As Worksheet
    Dim wshS            As Worksheet
    Dim x               As VbMsgBoxResult
    Dim b               As Boolean
    Dim i               As Long
    Dim lr              As Long
    Dim c               As Long
    Dim strClass        As String

    Const studentData   As String = "رصد الترم الثانى"
    Const shehada       As String = "شهادة"
    Const strSucce      As String = "*نا*"

    x = MsgBox("هل تريد طباعة كل الناجحين؟ إذا كانت الإجابة بنعم سيتم طباعة كل الناجحين أم لا سيقوم بطباعة الفصول", vbYesNoCancel)
    Select Case x
        Case vbYes
            b = True
        Case vbNo
            b = False
        Case vbCancel
            MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", vbExclamation: Exit Sub
    End Select

    Application.ScreenUpdating = False
        Set wshD = Sheets(studentData)
        Set wshS = Sheets(shehada)
        
        strClass = wshS.Range("W2").Value
        c = 2
    
        lr = wshD.Range("C7").End(xlDown).Row
        For i = 7 To lr
            If (b And wshD.Cells(i, 157) Like strSucce) Or (Not b And wshD.Cells(i, 4).Value = strClass) Then
                If c Mod 2 = 0 Then
                    wshS.Cells(3, 13) = wshD.Cells(i, 2)
                    wshS.Cells(12, 3) = wshD.Cells(i, 157)
                    wshS.Cells(12, 6) = wshD.Cells(i, 158)
                Else
                    wshS.Cells(19, 13) = wshD.Cells(i, 2)
                    wshS.Cells(28, 3) = wshD.Cells(i, 157)
                    wshS.Cells(28, 6) = wshD.Cells(i, 158)
                    wshS.Range("A1:P31").PrintOut
                    wshS.Cells(3, 13) = ""
                    wshS.Cells(19, 13) = ""
                End If
                c = c + 1
            End If
        Next i
    
        If wshS.Cells(19, 13) = "" And wshS.Cells(3, 13) <> "" Then
            wshS.Range("A1:P15").PrintOut
        End If
    Application.ScreenUpdating = True
End Sub