أبو حنــــين

اخي الحبيب سعد اخي الحبيب ابو سما جزاكم الله خيرا و كما يقول الشيخ الابراهيمي : هكذا كونو أو لا تكونو و في ما ورد في حديثه أيضا مخاطبا الشباب : ............. أتمثله مقداما على العظائم في غير تهوّر، محجامًا عن الصغائر في غير جبن، مقدرًا موقع الرجل قبل الخطو، جاعلا أول الفكر آخر العمل. أتمثله واسع الوجود، لا تقف أمامه الحدود، يرى كل عربي أخًا له، أخوة الدم، وكلَّ مسلم أخًا له، أخوة الدين، وكل بشر أخًا له، أخوة الإنسانية، ثم يُعطي لكل أخوة حقها فضلا أو عدلا. أتمثله حليف عمل، لا حليف بطالة، و جليس معمل، لا جليس مقهى، وبطل أعمال، لا ماضغَ أقوال، ومرتاد حقيقة، لا رائد خيال.

السلام عليكم يصبح كود الأخ سعد بهذه الطريقة Sub saad() Application.ScreenUpdating = False Sheets("Entry").Select al = Sheets("Database").[e10000].End(xlUp).Row If [d1] = "" Or [d2] = "" Or [d3] = "" Then MsgBox "أكمل البيانات أولا" Exit Sub ElseIf Not [c4].Value = [d4].Value Then MsgBox "!تأكد من إدخال القيد مع توازن الطرفين", vbExclamation, "إدخال خاطئ" Exit Sub ElseIf Sheets("Database").Range("e" & al).Value = [d2].Value Then MsgBox "!تأكد من عدم تكرار الفيد", vbExclamation, "إدخال خاطئ" Exit Sub 'Else End If If MsgBox("هل تريد ترحيل البيانات الحالية", vbInformation + vbOKCancel, "ترحيل") = vbCancel Then Exit Sub For r = 7 To Sheets("Entry").[c40].End(xlUp).Row With Sheets("Database").[d3005].End(xlUp) .Offset(1, 0) = Sheets("Entry").[d1].Value .Offset(1, 1) = Sheets("Entry").[d2].Value .Offset(1, 2) = Sheets("Entry").[d3].Value .Offset(1, 3) = Sheets("Entry").Cells(r, 3) .Offset(1, 4) = Sheets("Entry").Cells(r, 4) .Offset(1, 5) = Sheets("Entry").Cells(r, 5) .Offset(1, 6) = Sheets("Entry").Cells(r, 6) End With Next r With Sheets("Entry") MsgBox "تم ترحيل السند رقم " & .Range("D2") & " بنجاح", vbInformation, "" .Range("C7:F40") = "" .Range("D1:D3") = "" End With Application.ScreenUpdating = True End Sub و اجو المعذرة من اخي سعد

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

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

اخي غير هذا الكود Private Sub Worksheet_Activate() Sheets("كشف حساب عميل").PivotTables("PivotTable1").RefreshTable End Sub بهذا الكود Private Sub Worksheet_Activate() Sheets("كشف حساب عميل").PivotTables(1).RefreshTable End Sub الكود موجود في صفحة كشف حساب عميل

جزاك الله خيرا و يمكن اختصار ذلك بالطريقة التالية مثال.rar

اخي لم توضح الامر هل البحث يكون 1 - مطابق للاسم 2 - أي حرف من الاسم

هذا غير ممكن اخي

استعمل هذا الكود Private Sub CommandButton1_Click() Application.Dialogs(xlDialogPrinterSetup).Show End Sub او هذا الكود Private Sub UserForm_Initialize() Label1 = Sheet1.PageSetup.Pages.Count End Sub

اخي وليد فتحي جزاكم الله خيرا تقبل تحياتي

اخي ابراهيم ان كنت تريد حساب عدد الاوراق التي تحتوي على بيانات للطباعة يمكن استعمال الكود التالي Private Sub UserForm_Initialize() For i = 1 To Sheet1.PageSetup.Pages.Count Label1 = i Next End Sub

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

السلام عليكم اخي ابو صلاح ماذا تعني بـ : . . . مع وضع خيار مطابقة للاصل او لا

و هذه محاولة اخرى لاثراء الموضوع Book1_1.rar

جرب هذه الطريقة TA3LIM_4.rar

هل تقصد بهذه الطريقة TA3LIM_3.rar

و عليكم السلام اخي ابو اميمه هذا تعديل في الكود ليكون الترتيب في كل قسم تصاعديا و ابتداءا من 1 TA3LIM_2.rar

السلام عليكم للفائدة هذه طريقة اخرى TA3LIM.rar

تم التعديل حسب الطلب شهادة مدرسية 3.rar

و هذا تعديل على الملف السابق شهادة مدرسية 2.rar

السلام عليكم جرب اخي البحث عن طريق تاريخ الميلاد شهادة مدرسية1.rar

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

السلام عليكم من القائمة أدوات --------> وظائف اضافيية تظهر لك نافذف تحتوي على بعض الوضائف الاضافية امسح علامة ( صح ) عنها ثم موافق

كود جميل جدا بارك الله فيكم يمكن اختصاره بالطريقة التالية Sub div1() Dim x As Double, i As Integer, r As Integer Dim c As Integer, m As Integer, j As Integer Dim lr As Integer Range("a5:I100").ClearFormats Range("a5:I100").ClearContents r = 5: c = 2 x = Cells(3, 3).Value If x < 0 Then x = Abs(x) End If If x Mod 2 = 0 Then m = x / 2 Else m = x / 2 + 0.5 For i = 1 To m If x Mod i = 0 Then Cells(r, c).Value = i c = c + 1 If c > 9 Then c = 2 r = r + 1 End If With Cells(r, c) .Borders.Value = 1 .Interior.ColorIndex = 36 End With End If Next i Cells(r, c).Value = Abs(x) Range("B5").Borders.Value = 1 Range("B5").ColorIndex = 36 End Sub او هذا الكود ايضا يفي بنفس الغرض Sub Abou_Hanine() With Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row) .ClearFormats: .ClearContents End With x = Range("A1").Value: r = 1 For i = 1 To x If x Mod i = 0 Then r = r + 1 Cells(r, 2) = i End If With Cells(r, 2) .Borders.Value = 1: .Interior.ColorIndex = 36 End With Next End Sub

6= الصف السادس i = حلقة التكرار 9 اصفناها لان i يبدأ بالواحد و 1+9=10 فيكون اول رقم يكتب في العمود رقم 10