أبن النيل قام بنشر يونيو 10, 2009 قام بنشر يونيو 10, 2009 الاستاذ/ صفوت أشكرك والشكر طبعاً غير كافى !!!
عبدالله باقشير قام بنشر يونيو 10, 2009 الكاتب قام بنشر يونيو 10, 2009 (معدل) السلام عليكم الاخ قصي اسم الورقة غير صحيح Sub اضافة_حذف() On Error Resume Next Dim XX As Shape Set XX = ActiveSheet.Shapes("الدائرة") With XX.TextFrame.Characters If .Text = "اضافة الدوائر" Then Circles1 .Text = "حذف الدوائر" Else RemoveCircles1 .Text = "اضافة الدوائر" End If End With On Error GoTo 0 End Sub تم تعديل يونيو 10, 2009 بواسطه خبور خير
cat101 قام بنشر يونيو 10, 2009 قام بنشر يونيو 10, 2009 (معدل) الف شكر الف شكر الملف فعلا هايفيد ممكن تظبط كود الترحيل تم تعديل يونيو 10, 2009 بواسطه cat101
قصي قام بنشر يونيو 10, 2009 قام بنشر يونيو 10, 2009 كتر الله من خيرك اول مرة انقل كود الى ملف من عندي بفضل الله ثم توجيهاتك اقصد كود الدوائر اما كود الترحيل بصراحة انا مش عارف تشكر ياباشا الملف به بعض الطلبات التي تحتاج الى ابداعاتك
عبدالله باقشير قام بنشر يونيو 10, 2009 الكاتب قام بنشر يونيو 10, 2009 السلام عليكم كود الحذف يحذف 1377 دائرة سريعا وتم عمل تنسيق شرطي مشابه لعمل الكود بمعادلة واحدة لجميع الخلايا =AND(ISNUMBER(Q$9);$B10>0;OR(Q10<Q$9;Q10="غ";Q10="غـ")) وتم تضبيط كود الترحيل للناجحين ودور ثاني Sub KH_Start() On Error Resume Next Dim M As Integer, N As Integer, X As Integer, R As Integer Sheet5.Range("A10:CX1000").Clear Sheet7.Range("A10:CX1000").Clear M = 10 ' اول صف لورقة الناجحين N = 10 ' اول صف لورقة دور ثان Application.ScreenUpdating = False With Sheet1 X = .Range("A" & .Rows.Count).End(xlUp).Row For R = 10 To X If .Range("CX" & R) = "ناجح" Then .Range("A" & R).Resize(1, 102).Copy KH_Paste Sheet7, M M = M + 1 End If If .Range("CX" & R) = "دور ثان" Then .Range("A" & R).Resize(1, 102).Copy KH_Paste Sheet5, N N = N + 1 End If Next R End With Application.ScreenUpdating = True MsgBox "تم ترحيل " & M - 10 & " طالب ناجح" & Chr(10) & Chr(10) & "تم ترحيل " & N - 10 & " طالب دور ثاني", vbMsgBoxRight, "الحمدلله" End Sub Sub KH_Paste(MySheet As Worksheet, KRow As Integer) On Error Resume Next With MySheet .Range("A" & KRow).PasteSpecial xlPasteValues .Range("A" & KRow).PasteSpecial xlPasteFormats .Range("A" & KRow) = KRow - 9 End With Application.CutCopyMode = False End Sub تفضل المرفق ________________________________1.rar
محمدي عبد السميع قام بنشر يونيو 10, 2009 قام بنشر يونيو 10, 2009 اللهم زد هذا الوجه وجه اخي خبور خير نورا واجعله دائما مأجورا
محمدي عبد السميع قام بنشر يونيو 10, 2009 قام بنشر يونيو 10, 2009 اخي الاستاذ الكريم خبور خيرالسلام عليكم ورحمة الله وبركاتهفي بعض الاوقات من الحب الشديد والعمل الراقي تجد الكلمات تقف حائرة لتوفيك حفكولكننا لايسعنا الا ان نقول لك جزاك الله كل خيرــــــــــــــنريد معادلة لتخرج لنا الناجح ومن عنده دور تان توضع في العمود cx10 وتكون شروطها كالآتياذا كان الطالب ليس غائبا في امتحان آخر العام ودرجته في امتحان اخر العام اكبر او تساوي الدرجة الموجودة في نفس عمود امتحان اخر العام والصف التاسع..وفي نفس الوقت تكون درجة الطالب في مجموع الفصلين اكبر من او تساوي الدرجة الموجودة بالصف التاسع في عمود مجموع الفصلين في هذه الحالة يكون الطالب ناجح وغير ذلك له دور تانوتقبل تحياتي وشكري
cat101 قام بنشر يونيو 11, 2009 قام بنشر يونيو 11, 2009 وتم عمل تنسيق شرطي مشابه لعمل الكود بمعادلة واحدة مفيده جدا جدا .. ولكن عيزة جزئية من اضافاتك لهذا التنسيق مثال .. لوان طالب حصل في مادة على مجموع الفصلين على 81 درجة مثلا وكان غايب في اتحان آخر العام او درجة امتحانه في اخر العام اقل من النهايه الصغرى لمادة الامتحان في اخر العام ........ في مثل هذه الحاله يجب ان يوضع دائره او تنسيق يعني الطالب له دور تان كود الحذف يحذف 1377 دائرة سريعا سرعه ملحوظة كتر الله من خيرك
عبدالله باقشير قام بنشر يونيو 12, 2009 الكاتب قام بنشر يونيو 12, 2009 (معدل) السلام عليكم الاخ / قصي ممكن ملف فيه بيانات اقرب الى الواقع ( بالنسبة للدرجات) حتى نستطيع التطبيق بشكل مثالي وبالنسبة للشهادات ممكن رقم عمود المادة مثلا نشاطات من اي عمود توخذ؟؟؟ تم تعديل يونيو 12, 2009 بواسطه خبور خير
قصي قام بنشر يونيو 13, 2009 قام بنشر يونيو 13, 2009 تفضل و الف الف شكر ________________________________1.rar
عبدالله باقشير قام بنشر يونيو 13, 2009 الكاتب قام بنشر يونيو 13, 2009 (معدل) السلام عليكم تطبيق التنسيق الجديد وايضا باضافة الدوائر ========================= مع استخراج حالة الطالب و مواد دور ثاني عند اضافتك للدوائر ========================= تم التطبيق على ثلاث مواد(عربي /انجليزي/ رياضيات) هل هناك مواد اخرى؟؟؟ ========================= كم تريد شهادات في ورقة الطباعة انظر الى تنسيق الشهادة او غير ما تريده حسب ما تريد ========================= اريد اجابات بالتفصيل الممل لو تكرمت ________________________________2.rar تم تعديل يونيو 13, 2009 بواسطه خبور خير
محمدي عبد السميع قام بنشر يونيو 14, 2009 قام بنشر يونيو 14, 2009 الاستاذ الجهبذ / عبد الله وعليكم السلام ورحمة الله وبركاته نقله نوعية في كود لدوائر الحمراء جزاك الله خيرا التنسيق الشرطي فاق الوصف عدد الشهادات في ورقة الطباعه 3
أبن النيل قام بنشر يونيو 14, 2009 قام بنشر يونيو 14, 2009 الأستاذ العلامه الكبير/ خبور السلام عليكم هل بمكن تطبيق كود الدوائر على ورقة الشهادة؟؟ حيث أننى طبقتها على ورقة شيت ولكن حاولت على الشهادة ولم أفلح!!!!!! ___________________________1.rar
israabbasi قام بنشر يونيو 15, 2009 قام بنشر يونيو 15, 2009 السلام عليكم ورحمة الله بعد غياب طويل أود أن أشكر الجهود المبذولة في ها الموضوع, لقد أثار فضولي الساعة الالكترونية الموجودة في الفايل هل من أحد يدلني على كيفية القيام بها في الاكسل؟ مشكورة مقدما
عبدالله باقشير قام بنشر يونيو 15, 2009 الكاتب قام بنشر يونيو 15, 2009 (معدل) السلام عليكم ISRA انظر الى الرابط: بخصوص ساعات بصيغة الفلاش http://www.officena.net/ib/index.php?showtopic=27879&hl= ======================================= الاخ / ابن النيل ---------------حفظه الله تفضل كود اضافة الشهادات مع الدوائر مع ضبط اعدادات تحضير الشهادات للطباعة شهادة في كل ورقة Sub KH_ADD_S() Dim MyRng As Range, MyCell As Range Dim X As Integer, R As Integer, Y As Integer Set MyRng = ورقة1.Range("A12:DL51") Set MyCell = Range("نموذج_الشهادة") KH_Clear Application.ScreenUpdating = False X = 25 MyCell.Copy For R = 1 To MyRng.Rows.Count - 1 Range("B" & X).PasteSpecial xlPasteAll X = X + 22 Next R X = 12 With MyRng For R = 1 To .Rows.Count Range("F" & X) = .Range("H" & R) Range("P" & X) = .Range("B" & R) Range("E" & X + 7) = .Range("DK" & R) Range("J" & X + 7) = .Range("DL" & R) Range("D" & X + 5).RowHeight = 33 For C = 4 To 19 .Cells(R, Cells(1, C)).Copy Cells(X + 5, C).Select ActiveSheet.Paste Selection.PasteSpecial xlPasteValues Next C X = X + 22 Next R With ActiveSheet Y = .UsedRange.Rows.Count .PageSetup.PrintArea = "$B$3:$T$" & Y End With End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub هذا كود حذف الدوائر والشهادات Sub KH_Clear() Dim shp As Shape, Y As Integer Application.ScreenUpdating = False With ActiveSheet .Range("F12:L12,P12:Q12,D17:S17,E19:H19,J19:S20").ClearContents Y = .UsedRange.Rows.Count + 25 .Rows("25:" & Y).Delete .PageSetup.PrintArea = Range("نموذج_الشهادة").Address End With For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp ActiveWindow.ScrollRow = 1 End Sub تفضل المرفق ___________________________1.rar تم تعديل يونيو 15, 2009 بواسطه خبور خير
قصي قام بنشر يونيو 15, 2009 قام بنشر يونيو 15, 2009 كتر الله من خيرك يا استاذ خبور التنسيق حلو حلو والدوائر روعه كنا منتظرينها من زمان التغيير في الشهادة كلمة المجموع هنسميها التقدير والمجموع الكلي هاتبقى التقدير العام كتر الله من خيرك الاورف التانيه ممكن تملاها كل الكشوف مطلب نطبعها كشوف الناحخين والدور التاني على ورق كبير شوف اخسن مقاس عشان الكتابه تطلع واضحة والكشوف التانية على ورق ايه فور
أبن النيل قام بنشر يونيو 15, 2009 قام بنشر يونيو 15, 2009 السلام عليكم ISRA انظر الى الرابط: بخصوص ساعات بصيغة الفلاش http://www.officena.net/ib/index.php?showtopic=27879&hl= ======================================= الاخ / ابن النيل ---------------حفظه الله تفضل كود اضافة الشهادات مع الدوائر مع ضبط اعدادات تحضير الشهادات للطباعة شهادة في كل ورقة Sub KH_ADD_S() Dim MyRng As Range, MyCell As Range Dim X As Integer, R As Integer, Y As Integer Set MyRng = ورقة1.Range("A12:DL51") Set MyCell = Range("نموذج_الشهادة") KH_Clear Application.ScreenUpdating = False X = 25 MyCell.Copy For R = 1 To MyRng.Rows.Count - 1 Range("B" & X).PasteSpecial xlPasteAll X = X + 22 Next R X = 12 With MyRng For R = 1 To .Rows.Count Range("F" & X) = .Range("H" & R) Range("P" & X) = .Range("B" & R) Range("E" & X + 7) = .Range("DK" & R) Range("J" & X + 7) = .Range("DL" & R) Range("D" & X + 5).RowHeight = 33 For C = 4 To 19 .Cells(R, Cells(1, C)).Copy Cells(X + 5, C).Select ActiveSheet.Paste Selection.PasteSpecial xlPasteValues Next C X = X + 22 Next R With ActiveSheet Y = .UsedRange.Rows.Count .PageSetup.PrintArea = "$B$3:$T$" & Y End With End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub هذا كود حذف الدوائر والشهادات Sub KH_Clear() Dim shp As Shape, Y As Integer Application.ScreenUpdating = False With ActiveSheet .Range("F12:L12,P12:Q12,D17:S17,E19:H19,J19:S20").ClearContents Y = .UsedRange.Rows.Count + 25 .Rows("25:" & Y).Delete .PageSetup.PrintArea = Range("نموذج_الشهادة").Address End With For Each shp In ActiveSheet.Shapes If shp.AutoShapeType = msoShapeOval Then shp.Delete Next shp ActiveWindow.ScrollRow = 1 End Sub تفضل المرفق ]حاجه ولا أروع أنت مبدع وفنان وإيه تانى مش عارف!!!!!!!!!!!!!!!
هشام شلبى قام بنشر يونيو 15, 2009 قام بنشر يونيو 15, 2009 والله العظيم انت فنان واحسن فنان فى الدنيا بارك الله فيك من فضلك انظر هذا الرابط http://www.officena.net/ib/index.php?showtopic=28710
أبن النيل قام بنشر يونيو 16, 2009 قام بنشر يونيو 16, 2009 السلام عليكم الاستاذ الغالى/ خبور بك خير بعد ما قمت بزيادة عدد الطلاب فى الشيت حسب مدرستى حذف الدوائر أصبح ثقيل جداً يكاد لا يعمل وكذلك الشهادات هل من حل !!!! جعلك الله عوناً للغلابه اللى زينا؟؟؟؟؟ ___________________________1.rar
عبدالله باقشير قام بنشر يونيو 16, 2009 الكاتب قام بنشر يونيو 16, 2009 (معدل) السلام عليكم الاخ /ابن النيل--------------حفظه الله هل ستحتاج في عملك الى اضافة 7500 دائرة اعمل بيانات اقرب الى الواقع حتى تتاكد بشكل قطعي ============= الاخ /قصي--------------حفظه الله تم عمل الشهادات وكشوفات الناجحين ودورثاني راجع المرفق ________________________________3.rar تم تعديل يونيو 18, 2009 بواسطه خبور خير
أبن النيل قام بنشر يونيو 16, 2009 قام بنشر يونيو 16, 2009 (معدل) السلام عليكم الاخ /قصي--------------حفظه الله تم عمل الشهادات وكشوفات الناجحين ودورثاني راجع المرفق ________________________________3.rar ============================================= الاخ /ابن النيل--------------حفظه الله هل ستحتاج في عملك الى اضافة 7500 دائرة اعمل بيانات اقرب الى الواقع حتى تتاكد بشكل قطعي علم ياباشا تم تعديل يونيو 17, 2009 بواسطه أبن النيل
محمدي عبد السميع قام بنشر يونيو 17, 2009 قام بنشر يونيو 17, 2009 حفظك الله ورعاك ايها الاستاذ الكبير / عبد اللهعمل ولاأروع ولكننا نتعشم في كرمك في ** يضاف الدوائر الى الشهادات ** في الشهادات نريد فصل شهادات الناجحين لوحدها ثم شهادات الدور التاني لوحدها ** في الشهادات مكتوب فيها ( له دور ثانن ) نريد زيادة حرف الجر في فتصبح ( له دور ثان في ) ...ـ
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.