شوقي ربيع

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

اما باقي الملفات ليست مفهومة

الرجاء التوضيح اكثر

حبيبنا حماده عمر

رحمة الله تعالى على والديك دنيا و اخرة

و حمدا لله على سلامتك و الله اشتقنالك اخي الحبيب

و ان شاء الله موفق في عملك هذا

تحياتي لك

مشاء الله عليك اخي ياسر تطور ملحوظ في استعمال الاكواد

اعجبتني طريقة استعمالك للمصفوفات

تحياتي

اللف مبروك لاخينى و حبيبنا الاستاد يحيا حسين يستاهل كل الخير

ان شاء الله المزيد من النجاح و التالق

تحياتي

17 ساعات مضت, ياسر خليل أبو البراء said:

عوداً حميداً أخي الغالي شوقي ربيع .. لكم اشتقنا لمساهماتك الرائعة ومشاركاتك الفعالة

عد إلينا عد إلى ديارك .. فقد اشتاق إليك أحبابك

تقبل وافر تقديري واحترامي

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

تحياتي للجميع

2 ساعات مضت, سعد عابد said:

اخوانى

كل انسان اجتهد وتعلم فمن حقه الاستفاده ولو بالقليل مثل ثمن الاداة

والاخ ياسر له خدمات داخل المنتدى وخارجه مجانية

وكل المنتديات لها جزء يطرح فيه الخدمات مدفوعة الاجر لكى يجد من يجتهد ثمرة لاعماله

اللهم اهدنا واهدى بنا واجعلنا سبب لمن اهتدى

 

 

السلام عليكم

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

تحياتي

السلام عليكم

الكود لا يحتاج الى اي تعديل ان اردت مثلا ان يبدأ الترقيم من السطر 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

تحياتي لك