يوسف عطا قام بنشر نوفمبر 25, 2012 مشاركة قام بنشر نوفمبر 25, 2012 السلام عليكم أخوتى الأعزاء الملف المرفق به كود لوضع الدوائر الحمراء على الشهادات الملف بإصدارة 2010 وبه الآتى 1. الشاشة تومض 3 مرات مع طبع كل شهادة مما يؤدى إلى تهنيج البرنتر وإلا فيجب أن أطبع الشهادات شيت تلو الآخر مما يعنى أن أضغط 350 مرة على زر الطباعة لطبع 1111 شهادة 2. الأوفيس فى مكان العمل بالمدرسة 2003 والجهاز قد لا يقبل أوفيس 2010 المطلوب تعديل الكود ليعمل على أوفيس 2003 وفى نفس الوقت محاولة تلافى عملية الوميض بالشاشة عدة مرات مع تغيير الشهادة علماً بأن عملية الطباعة لجميع الشهادات لها كود ولكنه غير مرفق بالملف والأكواد المرفقة بالملف هى كود الدوائر وكود طباعة نطاق متصل من الشهادات المحددة وكود تحديد خلية نشطة بشروط مع خالص تحياتى كود دوائر حمراء بالشهادات 2010.rar رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر نوفمبر 26, 2012 الكاتب مشاركة قام بنشر نوفمبر 26, 2012 للرفع رفع الله قدركم فى الجنة وبلغكم مناكم رابط هذا التعليق شارك More sharing options...
أبو حنــــين قام بنشر نوفمبر 26, 2012 مشاركة قام بنشر نوفمبر 26, 2012 أخي يوسف جربت الكود على 2003 و هو يعمل بطريقة جيدة اما بالنسبة للاهتزاز فقد اضفت فقط سطرين و اعتقد انه توقف عن الاهتزاز Sub Printno_From_To_() Application.ScreenUpdating = False Dim i As Integer For i = Range("G6") To Range("I6") Step 3 If i <= Range("I6") Then Range("K3") = i Activewindow.SelectedSheets.PrintOut From:=1, To:=1, Copies:=1, Collate:=True End If Next i Range("K3").Select Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر نوفمبر 26, 2012 الكاتب مشاركة قام بنشر نوفمبر 26, 2012 (معدل) السلام عليكم أبو حنين دام فضلك ليس هذا هو الكود المقصود يا الغلا الكود المراد التعديل عليه هو كود الدوائر الحمراء الموجود فى حدث الشيت وليس فى الموديول رجاء إعادة النظر فى الملف تم تعديل نوفمبر 27, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر نوفمبر 27, 2012 الكاتب مشاركة قام بنشر نوفمبر 27, 2012 للرفع رفع الله قدركم وبلغكم آمـــــــــــــــالكم وجعل أعمالكم فى موازين حسناتكم رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر نوفمبر 28, 2012 الكاتب مشاركة قام بنشر نوفمبر 28, 2012 للرفع رفع الله قدركم وبلغكم آمـــــــــــــــالكم وجعل أعمالكم فى موازين حسناتكم رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر نوفمبر 30, 2012 الكاتب مشاركة قام بنشر نوفمبر 30, 2012 للرفع رفع الله قدركم وبلغكم آمـــــــــــــــالكم وجعل أعمالكم فى موازين حسناتكم إخوانى الأعزاء لو الأمر شديد الصعوبة إخبرونى حتى أبحث فى إتجاه آخر ولكنى أرى الأمر هين كود يعمل جيداً على إصدارة 2010 ولا يعمل على إصدارة 2003 المطلوب تعديله ليعمل على 2003 وبالتأكيد الأمر سهل لذوى الخبرة من الأساتذة الأجلاء بالمنتدى وهم كثر كذلك موضوع الوميض عند إستخدام كود الدوائر أعتقد أن خبراء الأكواد ببساطة سيضيفون سطر ما فى الكود لكى يتوقف الوميض بسهولة كبيرة بالنسبة لهم وفقكم الله رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2012 مشاركة قام بنشر ديسمبر 1, 2012 الأخ الكريم يوسف حاول توضيح طلبك بتفصيل أكثر رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 1, 2012 الكاتب مشاركة قام بنشر ديسمبر 1, 2012 الأخ الغالى ياسر بك المطلوب أن يتم تعديل كود إضافة الدوائر بالملف المرفق بالمشاركة الأولى كالتالى 1. أن يعمل على أوفيس 2003 2. أن يتم منع الوميض الذى يحدث 3 مرات اثناء عمل الكود ملحوظة الكود المراد تعديله موجود فى حدث الشيت وليس فى الموديول بس كدة رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 1, 2012 مشاركة قام بنشر ديسمبر 1, 2012 جرب الكود بهذا الشكل قمت بإضافة بسيطة... ممكن أعرف ما هي رسالة الخطأ التي تظهر لك عندما تقوم بتشغيله على أوفيس 2003 لأني بستخدم 2007؟ Private Sub Worksheet_Calculate() Dim c As Range Dim MyRng As Range, V As Shape Dim G As Integer, R As Integer, d As Integer '================================================ G = 2 ' ÚãæÏ ÑÞã ÇáÌáæÓ R = 15 ' ÕÝ ÇáÏÑÌÇÊ Set MyRng = Range("e16:p44") ' äØÇÞ ÇáÎáÇíÇ ÇáÐí ÊÑíÏ ÇÖÇÝÉ ÇáÏæÇÆÑ ÝíåÇ '================================================ Application.ScreenUpdating = False Application.EnableEvents = False '==============ÍÐÝ ÇáÏæÇÆÑ ÇáÓÇÈÞÉ==================== For Each V In ActiveSheet.Shapes If V.Top = Rows(16).Top + 1 Or V.Top = Rows(30).Top + 1 Or V.Top = Rows(44).Top + 1 Then V.Delete Next '================================================ For Each c In MyRng If Cells(c.Row, G) = 0 Or Cells(c.Row, G) = "" Then GoTo 1 If IsNumeric(Cells(R, c.Column)) And Not IsEmpty(Cells(R, c.Column)) And (c.Value < Cells(R, c.Column) Or c.Value = "Û") And c.Value <> "" Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 2 d = d + 1 End If 1 Next Application.EnableEvents = True Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 2, 2012 الكاتب مشاركة قام بنشر ديسمبر 2, 2012 للأسف أخى الغالى ياسر بك لم يظبط معى الملف على أوفيس 2003 رغم أنه شغال على أوفيس 2010 طيب هل ظبط معك على أوفيس 2007 ؟؟ مرفق الملف 2003 دوائر 2003.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 2, 2012 مشاركة قام بنشر ديسمبر 2, 2012 (معدل) الملف المرفق لم يتم تحميله جيداً أرجو إعادة رفعه تم تعديل ديسمبر 2, 2012 بواسطه YasserKhalil رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 2, 2012 الكاتب مشاركة قام بنشر ديسمبر 2, 2012 (معدل) الملف المرفق لم يتم تحميله جيداً أرجو إعادة رفعه تفضل أخى الغالى دوائر 2003.rar تم تعديل ديسمبر 2, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
حسن الحاوى قام بنشر ديسمبر 2, 2012 مشاركة قام بنشر ديسمبر 2, 2012 أستاذ / يوسف عطا التعديل الجديد الذى قمت به على شهادتكم والذى يتميز بسرعة التنفيذ ( رسم الدوائر )باستخدام الكود الخاص بى بعد إختصاره وأيضاً سرعة الحذف باستخدام كود أستاذ خبور خير بعد تعديله ليتناسب مع كود رسم الدوائر الخاص بى أنظر المرفقات يا ريت تقولى رأيك شهادات1.rar رابط هذا التعليق شارك More sharing options...
حسن الحاوى قام بنشر ديسمبر 2, 2012 مشاركة قام بنشر ديسمبر 2, 2012 هناك تعديل بسيط فى أول الكود ممكن حضرتك تلاحظه فى أول 3 أسطر Sub إضافة_الدوائروالمربعات_شهادات2_نقر() Application.ScreenUpdating = False Application.EnableEvents = False حذف_الدوائر_والمربعات_شهادات2_نقر إضافة_الدوائر_شهادات2_نقر Application.EnableEvents = True Application.ScreenUpdating = True End Sub Sub إضافة_الدوائر_شهادات2_نقر() ' ' إضافة_الدوائر_شهادات2_نقر ماكرو ' الماكرو مسجل 17/05/2012 بواسطة مجدى الحاوى ' Activewindow.Zoom = 100 ActiveSheet.Unprotect '===================================================== ' رسم شكل بيضاوى ActiveSheet.Shapes.AddShape(msoShapeOval, 0.75, 0.75, 36, 17).Select 'تنسيق الشكل البيضاوى Selection.ShapeRange.Fill.Solid Selection.ShapeRange.Fill.Transparency = 0# Selection.ShapeRange.Line.Weight = 1.5 Selection.ShapeRange.Line.DashStyle = msoLineSolid Selection.ShapeRange.Line.Style = msoLineSingle Selection.ShapeRange.Line.Transparency = 0# Selection.ShapeRange.Line.Visible = msoTrue Selection.ShapeRange.Line.ForeColor.SchemeColor = 64 Selection.ShapeRange.Line.BackColor.RGB = RGB(255, 255, 255) Selection.ShapeRange.Fill.Visible = msoFalse Selection.Name = "oval 1" '===================================================== 'تحديد لشكل البيضاوى وقصه المسمى oval 1 ActiveSheet.Shapes.Range(Array("oval 1")).Select Selection.Cut '===================================================== ' الشهادة الأولى ' الشهادة الأولى Dim R As Integer 'تحديد أول خلية فى مادة اللغة العربية R = 15 Range("E16").Select For i = 1 To 9 If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select Next '===================================================== 'تحديد أول خلية فى مادة التربية الدينية ActiveCell.Offset(0, 2).Select If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select '===================================================== 'اللغة الفرنسية ليست مادة نجاح ورسوب وبالتالى لا يتم رسم دوائر لها '===================================================== ' الشهادةالثانية 'تحديد أول خلية فى مادة اللغة العربية R = 29 Range("E30").Select For i = 1 To 9 If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select Next '===================================================== 'تحديد أول خلية فى مادة التربية الدينية ActiveCell.Offset(0, 2).Select If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select '===================================================== 'اللغة الفرنسية ليست مادة نجاح ورسوب وبالتالى لا يتم رسم دوائر لها '===================================================== '===================================================== 'الشهادة الثالثة 'تحديد أول خلية فى مادة اللغة العربية R = 43 Range("E44").Select For i = 1 To 9 If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select Next '===================================================== 'تحديد أول خلية فى مادة التربية الدينية ActiveCell.Offset(0, 2).Select If ActiveCell.Value < Cells(R, ActiveCell.Column) Or ActiveCell.Value = "غ" Then ActiveSheet.Paste End If ActiveCell.Offset(0, 1).Select '===================================================== 'اللغة الفرنسية ليست مادة نجاح ورسوب وبالتالى لا يتم رسم دوائر لها '===================================================== ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True, AllowFiltering:=True ' ' End Sub Sub حذف_الدوائر_والمربعات_شهادات2_نقر() ' ' ' كود الحذف ActiveSheet.Unprotect '===================================================== ' حذف الدوائر Dim V As Shape For Each V In ActiveSheet.Shapes If V.Name = "oval 1" Then V.Delete Next ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _ , AllowSorting:=True, AllowFiltering:=True End Sub رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 2, 2012 الكاتب مشاركة قام بنشر ديسمبر 2, 2012 بالفعل التعديل إختصر الكود وجعله أكثر سلاسة ولكنه لا زال لا يقوم بالعمل أوتوماتيكياً من حيث إضافة وإزالة الدوائر تلقائياً أثناء إستعراض الشهادات خاصة مع إستخدام أسهم التقديم والتأخير للشهادات صفحة صفحة وجارى عمل كود لوضع الدوائر بالشهادة بمساعدة خاصية التحقق من الصحة فى أوفيس 2003 وقد قاربت على إعتمادها وينقصها الشئ اليسير وقد أحتاج مساعدة من الزملاء خبراء الأكواد لإضافة سطر أو سطرين للكود ليعمل أوتوماتيكياً تماماً رابط هذا التعليق شارك More sharing options...
حسن الحاوى قام بنشر ديسمبر 2, 2012 مشاركة قام بنشر ديسمبر 2, 2012 أنظر إلى هذا التعديل ستجد ما تريد شهادات2.rar رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 3, 2012 الكاتب مشاركة قام بنشر ديسمبر 3, 2012 (معدل) أخى حسن أنظر إلى هذا الملف التنقل بين الشهادات بالكتابة فى الخلية الزرقاء وليس بالأسهم والقوائم المنسدلة ولكن عند الطبع تظهر الدوائر تلقائياً بطريقة مظبوطة سواء طبع كل الشهادات أو طبع شهادات معينة أو صفحات محددة والمشكلة التى تواجهنى حالياً هى 1. الكود لا يعمل عند نقله لملفى الاصلى ولا أعرف السبب 2. الكود متعارض مع كود أخر فى نفس الشيت عند تفعيل الكودين 3. لازلت لم أتوصل لطريقة لوضع المربع حول درجة الطالب الراسب حكماً فى مادة ما علماً بأننى أفكر فى وضع معادلة لجلب الدرجة الأقل من 15 فى تحريرى 2 بترتيب المواد فى جدول مجاور لجدول الدرجات فكرة الكود وضع دائرة عند عدم التحقق من صحة الرقم الموجود فى خلية الدرجة دوائرشهادات.rar تم تعديل ديسمبر 3, 2012 بواسطه يوسف عطا رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر ديسمبر 19, 2012 مشاركة قام بنشر ديسمبر 19, 2012 (معدل) السلام عليكم جرب المرفق وهو ورقة 13 فقط Ali_Sh_2007.rar Ali_Sh_2003.rar تم تعديل ديسمبر 19, 2012 بواسطه عباد رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 19, 2012 الكاتب مشاركة قام بنشر ديسمبر 19, 2012 الف شكر يا أخى الغالى جارى تحميل الملف رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 19, 2012 الكاتب مشاركة قام بنشر ديسمبر 19, 2012 للأسف يا أخى الغالى لم يعمل الملفان كلاهما لم يعملان معى رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر ديسمبر 19, 2012 مشاركة قام بنشر ديسمبر 19, 2012 الملف المرسل من قبلك على الرابط لم يعمل معي فعدلت على الأكواد عدة محاولات حتى عمل معي على الملف الأساسي مالأوفيس المستخدم لديك ؟ رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 19, 2012 الكاتب مشاركة قام بنشر ديسمبر 19, 2012 أوفيس 2003 الملفان مرة أخرى مرفقان هنا الملف الكبير مضغوط مرتين ليمكن رفعه بالمنتدى كنترول 2 2013.rar دوائر الشهادات نهائى.rar رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر ديسمبر 20, 2012 مشاركة قام بنشر ديسمبر 20, 2012 انا مسحت اوفيس 2007 ونصبت اوفيس 2003 وجربت الكود يعمل 100% جرب المرفقات كنترول 2_A - 2013.part01.rar رابط هذا التعليق شارك More sharing options...
يوسف عطا قام بنشر ديسمبر 21, 2012 الكاتب مشاركة قام بنشر ديسمبر 21, 2012 بعد تنزيل الملف وفك الضغط عنه تظهرلى رسالة أن الجزء الثانى من الملف مفقود رجاء إعادة الرفع أو إرساله على الإيميل الف شكر رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.