نجوم المشاركات

أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد في أحدي الموضوعات علي منتدانا الكريم وفي موضوع لاحد الأخوة بطلب برنامج ليتمكن من ادارة الأشتراكات الشهرية (اشتراكات DSL - كروت - توزيع شبكات انترنت او شبكات الكابل التلفزيوني ) وما الي ذلك من الاشتراكات التي تحتاج لمتابعة شهرية علي انتهاء صلاحية اسم المستخدم مثلا او متابعة حركة السداد المختلفة لذلك وفقني الله سبحانه وتعالي لتلك الفكرة بعمل برنامج يقوم بمتابعة تلك الاشتراكات الشهرية ومتابعة سداد وعمل وطباعة تقارير عن المديونية والمبيعات وكشف حساب للعميل وما الي ذلك من العمليات التي يمكن ان يحتاجها المستخدم لادارتها وكذلك ادخال اغلبية البيانات تلقائيا كرقم ايصال السداد مسلسل العميل تاريخ نهاية الاشتراك وادعو الله سبحانه وتعالي ان اكون وفقت في البرنامج وان يكون فيه النفع ويمكن تطويع البرنامج ليتلائم مع ادارة المشروعات الفردية الصغيرة ايضا ولا تنسونا من دعوة صالحة في ظهر الغيب بصلاح الحال ناتي لشرح بعض خصائص البرنامج المختلفة أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب Manage Subscriptions By Dahy al Gharieb.rar

السلام عليكم ورحمة الله وبركاتة موضوعنا اليوم اردت ان تكون صيغتة صيغة عامة تخدم الكثير من موضوعات جداول البيانات وهو ادراج مجموع كل صفحة وايضا المجموع الكلي وكنت قد قدمت هذا الموضوع منذ سنوات وقد اعادت هذة الذكري الي ذهني احدي المشاركات منذ ايام قليلة فبحثت عن الموضوع ولكني لم اجده ثم بحثت في المنتديات الاجنبية لعلي اجد كود لهذا الموضوع فلم اجد الا كود واحد فقط يغطى هذا الموضوع وهو للمبرمج Ole P. Erlandsen منذ عام 1999 وهو كود وحيد لا يوجود غيره في اي منتدي عربي او اجنبي حاولت تطويعة ( من باب الاستسهال بدلا من كتابة كود جديد ) ولكن صعب عليا تطويعه فتركت الموضوع ثم امس ومضت لي فكرة بناء كود جديد فتوكلت علي الله وكانت هذه النتيجة الكود له 3 مدخلات يجب ضبطها وهي اول 3 سطور في الكود '========================================= First_Cel = "A1" ' عنوان اول خلية في جدول البيانات Count_Row_In_Page = 10 ' عدد الصفوف في كل صفحة Col_Total = "E" ' عمود المجموع '========================================= انظر المرفقات الكود Option Base 1 Sub Subtotals_For_Each_Page() ' '======================================================================= First_Cel = "A1" ' عنوان اول خلية في جدول البيانات Count_Row_In_Page = 10 ' عدد الصفوف في كل صفحة Col_Total = "E" ' عمود المجموع '========================================= Ttitle_1 = "اجمالـــي صفحـــة" Ttitle_2 = "اجمالـــي الصفحـــات :" '======================================================================= ScreenOff Dim Sh_Total_Page As Worksheet Dim Rng As Range Dim Arr() Dim Arr_Page() '======================================================================= ActiveSheet.ResetAllPageBreaks Maximum_Row = ActiveSheet.HPageBreaks(1).Location.Row - 3 If Count_Row_In_Page < 1 Or Count_Row_In_Page > Maximum_Row Then MsgBox "عدد الصفوف لكل صفحة من 1 الي " & Maximum_Row: Exit Sub '======================================================================= Set Sh_Total_Page = Sheets("مجموع_الصفحات") First_Col = Range(First_Cel).Column Count_Col = Cells(Range(First_Cel).Row, Columns.Count).End(xlToLeft).Column End_Row = Cells(Rows.Count, First_Col).End(xlUp).Row Set Rng = Range(First_Cel).Offset(1) Set Rng = Range(Rng, Cells(End_Row, Count_Col)) Arr = Rng '======================================================================= With Sh_Total_Page .Cells.Delete Shift:=xlUp Range(Range(First_Cel), Cells(Range(First_Cel).Column, Count_Col)).EntireColumn.Copy .Range("A1").Insert Shift:=xlToRight .Rows(Range(First_Cel).Offset(1).Row & ":" & Rows.Count).ClearContents End With '======================================================================= Page_Counter = 1 Grand_Total = 0 Col_Total = Columns(Col_Total).Column For x = LBound(Arr) To UBound(Arr) Step Count_Row_In_Page ReDim Arr_Page(Count_Row_In_Page + 1, Count_Col) Row_Offset = x Total_Page = 0 For Row = 1 To Count_Row_In_Page Col_Counter = 0 Total_Page = Total_Page + Arr(Row_Offset, Col_Total) For Col = 1 To Count_Col Col_Counter = Col_Counter + 1 Arr_Page(Row, Col_Counter) = Arr(Row_Offset, Col_Counter) Next Row_Offset = Row_Offset + 1 On Error Resume Next Next Grand_Total = Grand_Total + Total_Page '======================================================================= Arr_Page(Count_Row_In_Page + 1, 1) = Ttitle_1 & Page_Counter & " : " Arr_Page(Count_Row_In_Page + 1, Col_Counter) = Total_Page Page_Counter = Page_Counter + 1 '======================================================================= With Sh_Total_Page End_Row = .Cells(Rows.Count, "A").End(xlUp).Row + 1 Set Rng = .Cells(End_Row, "A") Set Rng = Rng.Resize(Count_Row_In_Page + 1, Col_Total) Rng = Arr_Page End_Row = .Cells(Rows.Count, "A").End(xlUp).Row + 1 Range(.Cells(End_Row - 1, 1), .Cells(End_Row - 1, Count_Col)).Font.Bold = True Range(.Cells(End_Row - 1, 1), .Cells(End_Row - 1, Count_Col)).Font.ColorIndex = 5 End With Erase Arr_Page Next With Sh_Total_Page End_Row = .Cells(Rows.Count, "A").End(xlUp).Row + 1 .Cells(End_Row, "A") = Ttitle_2 .Cells(End_Row, Col_Total) = Grand_Total Range(.Cells(End_Row - 1, 1), .Cells(End_Row, Count_Col)).Font.Bold = True Range(.Cells(End_Row - 1, 1), .Cells(End_Row, Count_Col)).Font.ColorIndex = 5 Range(.Cells(End_Row, 1), .Cells(End_Row, Count_Col)).Font.ColorIndex = 3 .Select End With '======================================================================= Every_Row = Count_Row_In_Page + 1 With ActiveSheet .ResetAllPageBreaks TotalPageBreaks = ActiveSheet.HPageBreaks.Count Lastrow = .Cells(Rows.Count, "A").End(xlUp).Row For Row_Index = Every_Row + 2 To Lastrow Step Every_Row If Row_Index = Lastrow Then .HPageBreaks.Add Before:=.Cells(Row_Index + 1, 1) Else .HPageBreaks.Add Before:=.Cells(Row_Index, 1) End If Next End With TotalPageBreaks = ActiveSheet.HPageBreaks.Count ActiveSheet.HPageBreaks(TotalPageBreaks).Delete '======================================================================= End_Row = Cells(Rows.Count, "A").End(xlUp).Row Set Rng = Range(Range(First_Cel), Cells(End_Row, "A")) Rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete With Sh_Total_Page.PageSetup .PrintTitleRows = "$1:$1" End With End_Row = Cells(Rows.Count, "A").End(xlUp).Row + 1 Rows(End_Row & ":" & Rows.Count).Delete Shift:=xlUp On Error GoTo 0 '======================================================================= ScreenOn ' End Sub المرفقات ادراج مجموع كل صفحة & المجموع الكلي.rar

الأخ الكريم محمد عبدالسلام جرب المرفق التالى abo_abary_جلب بيانات من عمود C الى الخانة H62 في الفاتورة.rar

وعليكم السلام لما النموذج يُفتح ، فانه يأخذ بياناته من "مصدر البيانات" ، سواء جدول او استعلام او Recordset او حتى مصدر بيانات نموذج آخر مفتوح ، وعندما تعمل تغيير في مصدر بياناته ، فيجب ان تطلب من النموذج ان يقرأ من مصدر البيانات مرة اخرى، فيمكنك عمل هذا للنموذج (وليس للحقول ، حيث ان الحقول ستحصل على بياناتها تلقائيا من مصدر البيانات): او جعفر 401.data2.zip

بعد اجراء عملية الفلترة 1-حد ما يجب ان تنسخه بواسطة الماوس 2- اضغط Ctrl+C 3-اذهب الى ورقة جديدة 4- حدد الخلية حيث تريد اللصق 5- اضغط Ctrl+V 6- ارجع الى الصفحة الرئيسية واضغط Esc 7-اضغط على زر Reset يمكن ان يكون الحل بهذا الشكل شغل الامر reset اولاً ثم اختر الخلية المناسبة ثم اضغط على (زر جديد Copy data) TEST FILTERS salim 1.rar

سطر الذهاب للسجل السابق سيكون بهذا الشكل DoCmd.GoToRecord , , acGoTo, a - 1 بالتوفيق

جمعك الله ووالديك في الجنة وجميع الإخوة الكرام شكرا لاهتمامكم

وعليكم السلام تفضل هذه الدالة textNum عملتها لك يمكنك ان تفصل بها الحروف عن الارقام او العكس الآن هي مهيأة لفصل الارقم ، فقط مرر اسم الحقل اليها وحتى تعكس النتيجة يلزم تفعيل السطرين 3 ، 4 __ وحجب السطرين 1 ، 2 Public Function textNum(fildHrfRqm As String) Dim lets, lets2, lets3 Dim i, r As Integer r = Len(fildHrfRqm) For i = 1 To r lets = Mid(fildHrfRqm, i, 1) If IsNumeric(lets) Then lets2 = lets2 & lets ' السطر1 خاص بالارقام Else 'lets3 = lets3 & lets ' السطر3 خاص بالحروف End If Next textNum = lets2 'السطر2خاص بالارقام 'textNum = lets3' السطر4 خاص بالحروف End Function

بارك الله فيك أخي الحبيب سليم على الكود الرائع والجميل .. وإن كان ليس له علاقة بالطلب ، لكني أعجبت به وبفكرته الرائعة تقبل وافر تقديري واحترامي

جرب التعديل التالي ليناسب طلبك Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.Count > 1 Then Exit Sub If Not Intersect(Target, Range("C8:AD40")) Is Nothing Then If IsNumeric(Target) And Application.WorksheetFunction.CountIf(Range(Cells(Target.Row, 3), Cells(Target.Row, 30)), Target.Value) > 1 Then Application.EnableEvents = False Target.ClearContents MsgBox "No Way. Duplicate!", 64 Target.Activate Application.EnableEvents = False End If End If End Sub

أخي الكريم جمال يرجى تغيير اسم الظهور للغة العربية ، وبرجاء الصبر إلى أن يرد أحد الأعضاء .. فكل منا لديه مشاغله والله يعلم بظروف العباد ، والكل يقدم المساعدة حسب وقته وعلمه ولا أحد يبخل بمعلومة جرب الكود التالي عله يفي بالغرض Sub Export_Filtered_Data() Dim WB As Workbook Dim Rng As Range Set WB = Workbooks.Add Set Rng = ThisWorkbook.Worksheets("Sheet18").Cells.SpecialCells(xlCellTypeVisible) Rng.Copy WB.Worksheets("Sheet1").Range("A1") WB.Worksheets("Sheet1").Columns.AutoFit End Sub تقبل تحياتي

عدل قيمة ال a الى a = CurrentRecord بالتوفيق

بارك الله فيك أخي العزيز محمد أبو صهيب وجزاك الله خيراً توقعت أن يحتوي الملف على فورم .. عموماً ننتظر تطوير الملف ليظهر بشكل مناسب ويمكن للأعضاء تطويعه في مشاريعهم تقبل تحياتي

أخي الكريم جرب المعادلة التالية علها تفي بالغرض =IF(F18<3,ROUND(F8*0.5*((F18)+(J18/12)+(F20/365)),2),ROUND((F8*0.5*3)+(F8*1*((F18-3)+(J18/12)+(F20/365))),2)) تقبل تحياتي

بسم الله الرحمن الرحيم اخواني الكرام اسعد الله ايامكم وبعد هذا ملف رائع مبذول فيه جهد ملحوظ ندعو الله ان يجازي كل من ساهم في اخراجه الى النور وهو الاستاذ عادل حنفي واستاذ يوسف ****** ارجو من حضراتكم *** اضافة كود ليفتح الملف وتكون لغة الكتابه دائما باللغه العربيه ثانيا : اضافة جزئيه في كود التوزيع العشوائي انه عند الضغط على زر DO JOB ونكون قد كتبنا يدويا حرفالحاء لبعض الاسماء يتم التوزيع كاملا مع ترك هذه الاحرف ليكونوا احتياطيا وجزاكم الله كل خير توزيع الملاحظين.rar 342.93K 80 عدد مرات التحميل

السلام عليكم ورحمة الله وبركاته ارجو المساعدة فى إيجاد معادلة لإستخراج رقم من خلية بها نص ورقم معادلة استخراج رقم من نص.rar

وتفضل أخي المرفق السابق + دالة معرفة إستخراج رقم من نص بالمعادلات مع دالة معرفة.rar

وبالمعادلات لزيادة في إثراء الموضوع معادلة استخراج رقم من نص.rar

جرب المرفق معادلة استخراج رقم من نص.rar

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