عبدالله المجرب

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

بارك الله فيك اخي الفاضل على هذا الموضوع وجعله الله في ميزان حسناتك

بصراحة المطلوب غير مفهوم

لم انتبه لانك وضعت الرقم السري الا الان

السلام عليكم محرر الاكواد محمي وقد قمت بفتح الحماية === في الملف ستجد الفورم في الخانة الاولى (textbox1) ضع الحروف العربية الثلاثة وبين كل حرف مسافة هكذا د ح أ سيتم كتابتها باللغة الانجليزية في الخانة السفلى وفي الخانة الثانية جهة اليسار ضع الرقم بدون فواصل هذا ما فهمته من المطلوب ابو احمد.rar

وضح المطلوب بالضبط فيمكن استخدام الأكواد بدل المعادلات

السلام عليكم هل هذا يفي بالغرض Book 2.rar

السلام عليكم Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [B2:B100]) Is Nothing Then If Target.Value = Empty Then Exit Sub Target.Offset(0, 3) = Mid(Mid(Target, InStr(Target, "/") + 1, 20), InStr(Mid(Target, InStr(Target, "/") + 1, 20), _ "/") + 1, 20) & "/" & Mid(Mid(Target, InStr(Target, "/") + 1, 20), 1, _ InStr(Mid(Target, InStr(Target, "/") + 1, 20), "/") - 1) & "/" & Mid(Target, 1, InStr(Target, "/") - 1) End If End Sub هذا الحل بالكود واو انه متشابك ولكنه يؤدي الغرض منه تنسيق خلايا2.rar

او اليك هذا الرابط http://www.officena.net/ib/index.php?showtopic=40957

ضع هذا الكود لتعطيل عمل الزر Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Cancel = True End Sub

السلام عليكم كود جميل ومميز هذا اختصار للكود والاكتفاء بحلقة تكرارية لتحديد اعمدة الدرجات Sub Frame4_Click() ' كود إضافة الدوائر '===================================================== ' أمر لعدم إهتزاز الشاشة أثناء تنفيذ الكود Application.ScreenUpdating = False 'رسم الشكل البيضاوى - وجعله بدون تعبئة - وتغيير إسمه ' تغيير الإسم ضرورى لكى يكون جميع أسماء الدوائر التى سيتم لصقها بعد ذلك لها نفس الإسم تماما حتى يسهل حذفها جميعاً 'الرقم 54 يمثل عرض الشكل البيضاوى والذى يجب أن يكون نفس عرض العمود الذى يرسم به الدوائر 'الرقم 50 يمثل إرتفاع الشكل البيضاوى والذى يجب أن يكون نفس إرتفاع الصفوف داخل العمود الذى يرسم به الدوائر ActiveSheet.Shapes.AddShape(msoShapeOval, -7354.5, 1.5, 54#, 50#).Select With Selection .ShapeRange.Fill.Visible = msoFalse .Name = "Oval 1" .ShapeRange.Line.Weight = 3 .ShapeRange.Line.Visible = msoTrue .ShapeRange.Line.Style = msoLineSingle .ShapeRange.Line.Visible = msoTrue End With '===================================================== 'تحديد الشكل البيضاوى - ثم قصه ActiveSheet.Shapes.Range(Array("Oval 1")).Select Selection.Cut '===================================================== For r = 24 To 62 Step 6 If r = 42 Then r = 44 Cells(11, r).Select For I = 1 To [c1] 'يمثل عدد الطلاب C1 If ActiveCell.Value < Cells(10, r) Then ActiveSheet.Paste [a1] = [a1] + 1 End If 'الأمر التالى يعنى تحديد والتحرك لأسفل أى الصف التالى مع البقاء فى نفس العمود ActiveCell.Offset(1, 0).Select Next I Next r Application.ScreenUpdating = True MsgBox (" تم إضافة عدد " & [a1] & " دائرة ") End Sub

الاستاذ الفاضل محمد صالح (ابو عبدالله) شكراً لك اخي ابو نصار شكراً لدعمك

بارك الله فيك استاذ محمد شرح وافي ومفيد جعله الله في ميزان حسناتك ورفع قدرك ابواحمد

السلام عليكم اخي فضل تفضل المرفق به ما طلبت form.rar

السلام عليكم اخي فضل هذا السطر لتجاوز الخطاء والخروج من الكود ان تم تحديد اكثر من خلية في العمود الذي تكتب فيه كلمة روجع (جرب مسح هذا السطر وتضليل اكثر من خلية وستعرف النتيجة) كما ان المتغير CL هو للخلايا في الورقة الاخرى بينما Target هو للخلايا التي ينطبق عليها حدث التغيير

عمل رائع مليئ بالافكار سلمت يمينك موضوع مميز

السلام عليكم استبدل الكود السابق بهذا Sub trheel1() Application.ScreenUpdating = False Sheets("1").Cells(Sheets("1").[B1500].End(xlUp).Row + 1, 2) = Cells(4, 3) For R = 5 To 9 Sheets("1").Cells(Sheets("1").[B1500].End(xlUp).Row, R - 2) = Cells(R, 3) Next R MsgBox "تم ترحيل البيانات بنجاح", vbInformation, "تم الترحيل" End Sub

السلام عليكم جرب المرفق (تم عمل كود في حدث التغيير) كود يقوم بوظيفتين.rar

السلام عليكم جرب المرفق تقويم.rar

ما شاء الله عمل مميز احسنت اخي ابو تميم

السلام عليكم تفضل بالمعادلات موردين.rar

السلام عليكم حلول ممتازة من الاخوة الكرام وانا مع حل الاخ احمد زمان باستخدام التصفية المتقدمة بسبب بساطة الكود وقوة النتائج حسب الشروط المدخلة وكل الشكر للاساتذة الكرام على التنوع في الحلول

السلام عليكم اخي فضل شكراً لك على هذه اللفته الكريمة واقول احبك الله الذي احببتنا فيه

الله يسلمك اخي الفاضل

السلام عليكم هذا حل بالاكواد بمجرد الضغط دبل كليك على الخلية سيتم نقلك الى الشيت المطلوب موردين.rar