ناصر سعيد قام بنشر أبريل 16, 2017 قام بنشر أبريل 16, 2017 لاساتذه المنتدى وعمالقته ربنا يبارك فيكم هذا ملف للاستاذ المحترم محمود الشريف يستخرج به الناجحين والراسبين ولكن بمعيار كلمه واحده مثلا ناجح .... ويوجد ناجح وناجحه او راسب وراسبه كيف يمكن تعديل هذه الجزئيه في الكود ؟ طباعة شهادات.rar طباعة شهادات.rar 1
ياسر خليل أبو البراء قام بنشر أبريل 16, 2017 قام بنشر أبريل 16, 2017 السلام عليكم أخي الكريم ناصر ابحث عن الإجراء الفرعي المسمى Sub Kh_JJJ(Nd As String) وعدل السطر التالي If .Cells(R, 1) = Nd Then ليكون بالشكل التالي If .Cells(R, 1) Like "*" & Nd & "*" Then 2
ناصر سعيد قام بنشر أبريل 16, 2017 الكاتب قام بنشر أبريل 16, 2017 الان ارفع لك القبعه .. جزاك الله كل خير وبارك لك استاذ ياسر خليل اكمل جميلك في جزئيه اخرى تعجبني بدايه هذا الكود بمعنى انه يضع كل المتغيرات في اول الكود اتعشم منكم ان تجعل هذا الكود في الملف المرفق في هذه المشاركه ان يتميز بهذه الميزه ( ان تكون المتغيرات في اول الكود ) شهادات رائعه لساجدة.rar
ياسر خليل أبو البراء قام بنشر أبريل 16, 2017 قام بنشر أبريل 16, 2017 وجزيت خيراً أخي الكريم ناصر اطلعت على الملف ووجدت عدد كيبر من الموديولات .. أي موديول أو كود تريد تعديله .. وهذه الميزة يمكن إضافتها باستبدال الجزء المتغير بجزء ثابت يتم استخدامه بشكل دائم مثال: لو أن لديك النطاق A1:B6 ومستخدم في الكود أكثر من مرة فيمكن ببساطة وضع سطر بهذا الشكل في بداية الكود Const strRange As String="A1:B6" ثم استخدم المتغير المسمى strRange (يمكن تسميته بما شئت ..) يمكن استخدامه في أي سطر موجود فيه النطاق على سبيل المثال : Sheets("Sheet1").Range("A1:B6").ClearContents سيكون بهذا الشكل بعد إضافة السطر الأول Sheets("Sheet1").Range(strRange).ClearContents لاحظ أنه تم استبدال النطاق A1:B6 بالمتغير الثابت وهكذا لأي متغير لديك ...
ناصر سعيد قام بنشر أبريل 16, 2017 الكاتب قام بنشر أبريل 16, 2017 اولا جزاك الله خيرا وبارك فيك الاستاذ ياسر خليل الكود الذي اقصده هو الكود الاول الخاص بالناجحين وعلى منواله ساغير الاكواد الاخرى
ياسر خليل أبو البراء قام بنشر أبريل 16, 2017 قام بنشر أبريل 16, 2017 جزيت خيراً أخي الكريم ناصر بمثل ما دعوت لي قمت منذ ساعة تقريباً بتسجيل فيديو يوضح كيفية عمل إجراء عام والأمر مشابه إلى حد كبير للمطلوب 1
ناصر سعيد قام بنشر أبريل 16, 2017 الكاتب قام بنشر أبريل 16, 2017 ربنا يبارك لك استاذ ياسر خليل == الفيديو لايعمل في المشاركه الاولى هل يمكن طباعه الشهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول ربنا يبارك لك استاذ ياسر خليل == الفيديو لايعمل في المشاركه الاولى هل يمكن طباعه الشهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول
ناصر سعيد قام بنشر أبريل 16, 2017 الكاتب قام بنشر أبريل 16, 2017 الفيديو يعمل .. جزاك الله كل خير استاذ ياسر خليل 1
ياسر خليل أبو البراء قام بنشر أبريل 17, 2017 قام بنشر أبريل 17, 2017 بارك الله فيك أخي الكريم ناصر ممكن توضيح للمطلوب بخصوص "شهادات بدل كلمه ناجح نكتب فصل ونطلع الشهادات بمعيه الفصول" 1
ناصر سعيد قام بنشر أبريل 17, 2017 الكاتب قام بنشر أبريل 17, 2017 الاستاذ المحترم ياسر خليل جزاك الله الف الف خير نحن عندما نضغط على زر الناجحين تظهر الشهادات بشرط ان يكونو ناجحين وعندما نضغط على زر الدور التاني تظهر الشهادات ولكن بشرط ان يكونوا لهم دور تان طيب عايزين الشهادات تطلع بشرط الفصول يعني عايز شهادات فصل 5/1 مثلا وهكذا
ياسر خليل أبو البراء قام بنشر أبريل 17, 2017 قام بنشر أبريل 17, 2017 أعتقد أن الأستاذ محمد صالح قدم حل لهذه الإشكالية على ما أذكر .. ألم يفي الحل بالغرض ...؟
ناصر سعيد قام بنشر أبريل 17, 2017 الكاتب قام بنشر أبريل 17, 2017 لا يا اخي لايوجد حل لهذا الكود حتى الان
ياسر خليل أبو البراء قام بنشر أبريل 17, 2017 قام بنشر أبريل 17, 2017 جرب الكود التالي .... 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
ناصر سعيد قام بنشر أبريل 17, 2017 الكاتب قام بنشر أبريل 17, 2017 ربنا يبارك لك استاذ ياسر خليل لوفيه خليه وفيها قائمه منسدله بالفصول .. هاتكون اسهل من الكتابه لتطابق اسم الفصل في القائمه المنسدله ربنا يكتبها في كفة حسناتك
ناصر سعيد قام بنشر أبريل 17, 2017 الكاتب قام بنشر أبريل 17, 2017 10 ساعات مضت, ياسر خليل أبو البراء said: MsgBox "لم يتم تنفيذ الأمر لأنك نقرت على إلغاء يا ناصر", جزاك الله كل خير وبارك فيك استاذ ياسر خليل
ياسر خليل أبو البراء قام بنشر أبريل 17, 2017 قام بنشر أبريل 17, 2017 قم بتصميم قائمة منسدلة بالفصول وجعل قيمة المتغير strClass تساوي تلك الخلية ولكن في تلك الحالة لن يكون ثابت Const بل يجب تغييره ليكون متغير بهذا الشكل Dim strClass as String strClass=Range("J6").Value باعتبار أن الخلية J6 ستحتوي على القائمة المنسدلة تقبل تحياتي
ناصر سعيد قام بنشر أبريل 17, 2017 الكاتب قام بنشر أبريل 17, 2017 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 هل يكون بهذا الشكل يا استاذ ياسر حفظك الله ؟ لانها لم تعمل معي معذره
ياسر خليل أبو البراء قام بنشر أبريل 17, 2017 قام بنشر أبريل 17, 2017 الكود بهذا الشكل سليم إن شاء الله ولكن طالما أننا سنتعامل مع أكثر من ورقة عمل فلابد من الإشارة لورقة العمل التي فيها قيمة الخلية (القائمة المنسدلة) قم بالإشارة إلى ورقة العمل قبل كلمة Range في هذا السطر strClass = Sheets(StudentData).Range("W2").Value 2
ناصر سعيد قام بنشر أبريل 18, 2017 الكاتب قام بنشر أبريل 18, 2017 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 جزاك الله الف الف خير استاذ ياسر تاتي باناجحين الفصل فقط اذا اخترنا لا اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان ) ===== نريدها اذا كان المعيار الفصل تاتي بكل الفصل ( ناجح و دور تان )
ياسر خليل أبو البراء قام بنشر أبريل 18, 2017 قام بنشر أبريل 18, 2017 أخي ناصر لم تذكر تلك النقطة من البداية ويبدو أن الموضوع بهذا الشكل يزاداد تعقيداً ..عموماً جرب تغيير السطرين لديك اللذين فيهما الشرط إلى هذا الشكل (لم أجرب لضيق الوقت لدي) If IIf(b = True, Sheets(StudentData).Cells(i, 157) Like "*" & "نا" & "*", True) And IIf(b = True, True, Sheets(StudentData).Cells(i, 4).Value = strClass) Then ستقوم بتغيير السطرين بنفس الأسلوب وجرب وأخبرني بالنتائج
ناصر سعيد قام بنشر أبريل 18, 2017 الكاتب قام بنشر أبريل 18, 2017 اخي الكريم استاذ ياسر خليل جزاك الله الف الف خير وبارك فيك السطرين لم يؤدو الغرض ==== في شهادات الفصول خرجت شهادات الناجحين من الفصل فقط
ياسر خليل أبو البراء قام بنشر أبريل 19, 2017 قام بنشر أبريل 19, 2017 سأحاول تجربة الكود مرة أخرى في أقرب وقت إن شاء الله 1
ناصر سعيد قام بنشر أبريل 19, 2017 الكاتب قام بنشر أبريل 19, 2017 جزاك الله كل خير وبارك لك استاذ ياسر خليل
ياسر خليل أبو البراء قام بنشر أبريل 19, 2017 قام بنشر أبريل 19, 2017 أخي الكريم ناصر جرب الكود التالي 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
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.