أبو حنــــين

جزاك الله خيرا أخي الحبيب رجب جاويش على مروركم الطيب و كلماتكم العطرة حفظكم الله و رعاكم و سدد خطاكم و جعل الجنة مثواكم

الإخوة الأحباء : الأستاذ : أحمد فضيله الأستاذ : عباس السماوي الأستاذ : مجدي يونس جزاكم الله خيرا على المرور حفظكم الله

السلام عليكم جرب المرفق بحث لصفحات متعددة.rar

عمل ممتاز أخي مصطفى جزاك الله خيرا تقبل مروري

جزاك الله خيرا أخي محمد

جزاك الله خيرا أخي الحبيب حماة عمر ( أبو سما ) على هذا الشعور الطيب أدعو الله ان تكون بخير انت و كل الأهل رمضان مبارك ان شاء الله

السلام عليكم هذا مثال على الكود السابق مثال.rar

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

استعمل الكود التالي Private Sub UserForm_Activate() Calendar = vbCalHijri TextBox1 = Format(Date, "dddd dd mmm yyyy" & "هـ") End Sub

غير الكود السابق بهذا الكود ( المرفق ) اضافة معادلة2.rar

جزاك الله خير أخي الحبيب حمادة عمر ( ليك وحشة كبيرة ) كلما سنحت لي الفرصة اتصل بالنت و لكن الحمد انا بخير تقبل كل شكري و تقديري =============================================================== أخي الكريم : Jo11 جزاكم الله خيرا على مروركم الطيب

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

السلام عليكم جرب المرفق أخي اضافة معادلة.rar

بعدما اعددت الرد انقطع التيار فجأة غير الكود السابق بالكود التالي لمنع الاهتزار Sub AbouHanin() Dim LR As Integer, x As Integer Application.ScreenUpdating = False LR = ورقة1.Cells(Rows.Count, "B").End(xlUp).Row LR1 = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row '---------------------------------------------------------------------- If ورقة1.Range("B7").Value = "" Then Exit Sub x = 8 For i = 7 To LR '---------------------------------------------------------------------- Range("C" & i).Resize(1, 15).Copy ورقة2.Range("C" & LR1 + x - 7).PasteSpecial xlPasteValues ورقة2.Range("B" & LR1 + x - 7) = LR1 + x - 13 '---------------------------------------------------------------------- x = x + 1 Next i With ورقة1 .Range("B7:P" & LR).ClearContents End With Last = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row ورقة1.Range("C7").Value = Val(ورقة2.Range("C" & Last).Value) + 1 ورقة1.Range("B7").Value = 1 Application.ScreenUpdating = True End Sub بالنسبة للسؤال الثاني لا اعرف موقع المعادلة و لم أرها فإن كانت في العمود مثلا L غير فقط هذا السطر Range("C" & i).Resize(1, 15).Copy بهذا السطر Range("C" & i).Resize(1, 9).Copy و ان كانت المعادلة في عمود آخر غير فقط الرقم 10 الى رقم آخر بحث : تبتدأ الحساب من العمود C وصولا الى العمود الذي يحتوي على المعادلة مثال : المعادلة موجودة في العمود H فيصبح بدلا من العدد 10 العدد 5 و تكون بذلك الخلية H غير معنبة بالترحيل

اخي حمدي جربت الترحيل و هو يعمل عندي انظر المرفق 2003 ترحيل يومية1.rar

أخي ابراهيم السلام عليكم و رحمة الله هذا الشطر للحفاظ على الترتيب التصاعدي في العمود B : أي 1 ’ 2 ، 3 ، 4 ، ........... إبتداءا من الخلية B7

السلام عليكم أضف موديل و انسخ هذا الكود في الموديل و ضع له زر لتشغيله Sub AbouHanin() Dim LR As Integer, x As Integer '---------------------------------------------------------------------- LR = ورقة1.Cells(Rows.Count, "B").End(xlUp).Row LR1 = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row '---------------------------------------------------------------------- If ورقة1.Range("B7").Value = "" Then Exit Sub x = 8 For i = 7 To LR '---------------------------------------------------------------------- Range("C" & i).Resize(1, 15).Copy ورقة2.Range("C" & LR1 + x - 7).PasteSpecial xlPasteValues ورقة2.Range("B" & LR1 + x - 7) = LR1 + x - 13 '---------------------------------------------------------------------- Application.CutCopyMode = False x = x + 1 Next i With ورقة1 .Range("B7:P" & LR).ClearContents End With Last = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row ورقة1.Range("C7").Value = Val(ورقة2.Range("C" & Last).Value) + 1 ورقة1.Range("B7").Value = 1 Application.ScreenUpdating = True End Sub

السلام عليكم أخي ضاحي الغريب عمل أكثر من ممتاز أعانك الله على تكملته تقبل مروري

ابداع × ابداع مثل ما عودتنا عليه أخي عبد الله جزاكم الله خيرا و حفظكم و رعاكم تقبل مروري و تحيلتي

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

السلام عليكم اخي ابراهيم جرب المرفق USER FORM.rar

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

العفو أخي أحمد جزاك الله خيرا أخي ناصر سعيد على مروركم الطيب

السلام عليكم غير هذا الكود Sub kh_Tgrba() Dim r As Integer Dim tst As String For r = 11 To 17 tst = kh_test(r) If Len(tst) Then Cells(r, 113) = "له دور ثانى فى" Else Cells(r, 113) = "ناجح" Cells(r, 114) = kh_test(r) Next End Sub بالكود التالي : Sub kh_Tgrba() Dim r As Integer Dim tst As String For r = 11 To 17 tst = kh_test(r) If Len(tst) Then Cells(r, 113) = "له دور ثانى فى" Else Cells(r, 113) = "ناجح" Cells(r, 114) = kh_test(r) If Cells(r, 113) = "ناجح" Then Cells(r, 114) = "منقول للصف الثانى" Next End Sub

بارك الله فيكم أخي ضاحي الغريب عى هذا العمل المميز جزاكم الله خيرا