شوقي ربيع

Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ' هنا ضع الامر الذي تريد تنفيذه بعد الضغط على زر انتر End If End Sub

السلام عليكم تم على السريع انشاء فورم جديد كليا تستطيع البحث بواسطة الرقم او الاسم او القب واضهار النتائج في اليستبوكس كما يمكن التعديل على البيانات الموجودة او اضافة بيانات جديدة تحياتي UFRabie.rar

السلام عليكم هذا حل للملف الاول Sub TestCount() Dim i As Byte, ii As Byte, iii As Byte For i = 2 To 7 ii = Application.CountIf(Range("a" & i & ":e" & i), 2) iii = Application.CountIf(Range("a" & i & ":e" & i), 1) If ii <> 0 And iii <> 0 Then Range("g" & i) = ii & "/ /" & iii If ii > ii * iii Or iii > ii * iii Then Range("g" & i).Font.Color = vbRed Next End Sub اما باقي الملفات ليست مفهومة الرجاء التوضيح اكثر

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

مشاء الله عليك اخي ياسر تطور ملحوظ في استعمال الاكواد اعجبتني طريقة استعمالك للمصفوفات تحياتي

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

انا المشتاق الى اخوتي في هذا السرح الجميل وما يمنعني عنكم الى مشاغل العمل تحياتي للجميع

السلام عليكم عمل حميل جزاك الله خيرا تحياتي

السلام عليكم الكود لا يحتاج الى اي تعديل ان اردت مثلا ان يبدأ الترقيم من السطر 9 كل ماعليك هو ان تجعل عنوين الجدول في السط 8 لان الكود يقراء تلقائيا اول سطر من العمود به بينات و يبداء الترقيم من السطر الذي يليه المهم ان لايكون هناك بينات فق العناوين في العمود c سلام

دائما هناك حل مع الاكسل Private Sub Worksheet_Change(ByVal Target As Range) Dim Lr As Long: Lr = Cells(Rows.Count, "B").End(xlUp).Row Dim myRange As Range Dim cell As Range Set myRange = Range("B9:B" & Lr) If Not Intersect(myRange, Target) Is Nothing Then For Each cell In myRange Range("a" & cell.Row) = cell.Row - 8 Next cell End If End Sub

السلام عليكم جرب هذا في حدث Change الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Range("B9:B50"), Target) Is Nothing Then If Range("a" & Target.Row - 1) <> "" Then Range("a" & Target.Row) = Target.Row - 8 End If End Sub معادلة في حدث الورقة للترقيم التسلسلي.rar

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

السلام عليكم Exe Icon Changer_2.rar

السلام عليكم اخي وصديقي ضاحي الغريب جزالك الله خيرا على هذا التحفة وهو ليس بجديد على فنان مثلك تحياتي

الله اكبر ان لله انا اليه راجعون اللهم اغفر له و ارحمه واجعل مثواه الجنة يااارب

السلام عليكم اخي غسان جزاك الله خير على هذا العمل مجهود تشكر عليه واصل على هذا المنوال و باذن الله ستحسن البرنامج الى احسن من هذا تحياتي لك

السلام عليكم ارجو من الاعظاء ابداء اقتراحاتهم في خصوص تصور لنموذج يكون متوافق مع اغلب المستعملين و سأعمل عليه ان شاء الله تياتي للجميع

اجل فلقد سهوة عن هاته النقطة افضل عدم هذه النقطة لانه في البحث عن الصنف نستعمل خاصية البحث بالنص التنبئي فليس من المعقول ان ينتقل المؤشر الى العمود الثاني بعد كتابة اي حرف يمكن استعمال هاته الخاصية في حالة عدم وجود البحث في الاصناف اي ان يكون الاختيار من القوائم مباشرة دون البحث عن اسم صنف بكتابة اول احرف اسمه لاكن يمكنك فقط الضغط على Entr أو Tab وسينتقل المؤشر مباشرتا الى العمود الموالي هذا لملف به التعديلات الخاصة بالتعديل و انشاء سطر تلقائيا عند اختيار صنف تحياتي للجميع FcteurRabie2.rar

جزاك الله خيرا اخي خزاني تحياتي لك

وفيك بركة اخي غسان و شكرا لمرورك بالموضوع تحياتي لك

شكرا لمرورك اخي احمد تحياتي لك

جازاك الله خيرا اخي سعد وشكرا جزيلا لكلماتك الجميلة تياتي لك

اخي الصقر حفضكم الله جزيل الشكر للمرورك بالموضوع و لعباراتك الجميلة تحياتي لك

شكرا جزيلا اخي ابا اسمعيل لعباراتك الجميلة لاضافة سطر جديد تلقائيا فقط اضف هذا الكود If IDRw = RwDt Then Call AddCont في الكلاس موديل المسمى ClsFct اخر الكود Private Sub MesComboBox_Change() فيصبح الكود على الشكل Private Sub MesComboBox_Change() If Len(MesComboBox.Name) = 8 Then RwDt = Left(MesComboBox.Name, 1) If Len(MesComboBox.Name) = 9 Then RwDt = Left(MesComboBox.Name, 2) If Len(MesComboBox.Name) = 10 Then RwDt = Left(MesComboBox.Name, 3) Call Shrch(MesComboBox.Text, MesComboBox.Name) Call SumTotal If IDRw = RwDt Then Call AddCont End Sub تحياتي لك