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

لا نتعدى على معلمينا و أساتذتنا لكنه تعدد الردود و تبادل الأفكار

السلام عليكم اهدي هذا البرنامج مفتوح السورس الي المنتدى واعضاءه الاعزاء كلمة المرور في كل البرنامج 1234 - البرنامج به كل ما يطلبه المحاسب بداية من ادخال الحسابات كما يحب المحاسب وايضا ادخالها كما هي في دفتر اليومية الخاصة به اي بنفس الترقيم المستخدم بشركته او مؤسسته وذلك من مميزات البرنامج لان كل البرامج التي في السوق تجد انها تفرض على المحاسب حسابات البرنامج والتي تكون ارقامها و ترتيبها مخالف لما هو معمول به عند المحاسب . - سند قيد يوميه - سند قبض - سند صرف - ترحيل تلقائي الى الاستاذ العام و الاستاذ المساعد و اليومية العامة و ميزان المراجعة و الحسابات الختامية - طباعة جميع التقارير التي يحتاجها المحاسب - عرض شجرة الحسابات وبه مميزات كثيرة ومفيدة للمحاسب الملف المرفق على اكسيس 2003 وان شاء الله سوف اقوم بتطويره على Vb.Net لي طلب وانا سوف اعتبره امانه لمن يعمل على البرنامج انه لا يلغي صورة ابني فهد من البرنامج تحت اي ظرف الرجاء من الادارة تثبيت الموضوع لاهميته ارجو ان يفيدكم ولا تنسونا بالدعاء اخوكم ابو فهد Acc2003.zip

عملنا انا وانت تقرير لطباعة الصف في صفحة واحدة ، سواء اكان هناك 30 او 50 طالب

وعليكم السلام لا تضيف حقل/حقول ، وانما اخفي الحقل/الحقول الاضافية و اجعل العرض = 0 (حتى لا ترى مسافة فاضية بين الحقول) ، يعني اعمل في التقرير 10 حقول بدل 4 (مثلا ، ولتفادي المشكلة مستقبلا) ، واجعل الكود يحسب عدد الحقول الموجوده في السنة ، وعليه يُظهر الحقول المطلوبة ، ويُخفي بقية الحقول جعفر

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

هذا الفيديو يوضح الأمر https://www.youtube.com/watch?v=AzOwrl-0RuE

يمكن عمل ذلك بدون كود Variable_print_Area_salim.xlsm

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

ما شاء الله استاذ ورئيس قسم استاذ علي جزاك الله خيراً وبارك الله لك

تم معالجة الأمر بالنسبة للملف القديم الذي رفعته (نمو ذج اخر على 3 صفحات مستقلة مع تحديد نطاق الطباعة اللازم لكل صفحة) الكود Option Explicit Sub filter_ME3() If ActiveSheet.Name <> "ورقة1" Then GoTo Exit_Me With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1") Dim T_sh As Worksheet Dim lr%, i%, new_lr%, k%, x Dim My_Table As Range: Set My_Table = _ S_sh.Range("A6").CurrentRegion Select Case S_sh.Range("b1") Case "ناجح" Set T_sh = Sheets("Salim") Case "راسب وله حق الإعادة" Set T_sh = Sheets("Salim1") Case "راسب وليس له حق الإعادة" Set T_sh = Sheets("Salim2") Case Else GoTo Exit_Me End Select ReDim arr(1 To 4) arr(1) = 1: arr(2) = 2: arr(3) = 3: arr(4) = 11 With T_sh .Select .Cells(4, 1).Resize(1000, 11).ClearContents .Cells(1, 1) = S_sh.Range("b1") .Range("Q2").Formula = "=AND(ورقة1!$K7=$A$1,ورقة1!$K8=0)" My_Table.AdvancedFilter 2, .Range("Q1:Q2"), _ .Range("A4"), 0 .Range("Q2").ClearContents .Cells(1, 1) = vbNullString '====================== lr = .Cells(Rows.Count, 1).End(3).Row If lr < 5 Then lr = 5 For i = lr To 6 Step -1 Rows(i).Insert Next new_lr% = .Cells(Rows.Count, 1).End(3).Row If new_lr% < 6 Then new_lr% = 6 For i = 6 To new_lr% + 1 Step 2 x = Application.Match(.Cells(i - 1, 1), _ S_sh.Columns(1), 0) + 1 .Cells(i, 4).Resize(, 7).Value = _ S_sh.Cells(x, 4).Resize(, 7).Value Next For i = 5 To new_lr% Step 2 For k = 1 To 4 .Cells(i, arr(k)).Resize(2, 1).MergeCells = True Next Next End With '========================== Exit_Me: Erase arr With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف مرفق دورsalim 3 sheets.xls

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

هذا مختصر و سريع أنشأت وظيفة لهذا الغرض Function myfun(fs As Integer) Dim rs As Recordset Dim rrr As Integer rrr = 1 Dim i, ii, iii As Integer Dim r As Integer Dim rr As Integer rr = 1 Set rs = CurrentDb.OpenRecordset("SELECT Students.sery, Students.Group, Students.kolaf, Students.mazroof FROM Students where (group =" & fs & ") order by group") rs.MoveFirst Do Until rs.EOF rs.Edit rs!kolaf = rr rs.Update If rrr Mod 50 = 0 Then rr = rr + 1 End If rrr = rrr + 1 rs.MoveNext Loop rs.MoveFirst rr = 1 rrr = 1 rs.Close Set rs = Nothing End Function و تستدعى هكذا Private Sub test1_Click() Dim i As Integer For i = 1 To 11 myfun i Next i End Sub و التنفيذ سريع حوالى 7 ثوان مع ملاحظة أن بالجدول أكثر من 15 ألف سجل كيرة رقم الغلاف والمظروف2003.mdb كيرة رقم الغلاف والمظروف.accdb و هذا الكود للمظروف Private Sub maz_Click() Dim rs As Recordset Dim rr As Integer Dim rrr As Integer rr = 1 rrr = 1 Set rs = CurrentDb.OpenRecordset("SELECT Students.sery, Students.Group, Students.kolaf, Students.mazroof FROM Students order by sery") Do Until rs.EOF rs.Edit rs!mazroof = rr rs.Update If rrr Mod 50 = 0 Then rr = rr + 1 End If rs.MoveNext rrr = rrr + 1 Loop rs.Close Set rs = Nothing End Sub

وهذا هو الكود المستخدم فى حدث الصفحة بالملف : Private Sub Workbook_Open() If Date >= DateValue("15/07/2018") Or Sheets("sheet1").Range("a1") = 1 Then Sheets("sheet1").Range("a1") = 1 MsgBox "Expire ÅäÊåÊ ÕáÇÍíÉ ÇáãáÝ" ThisWorkbook.Save Application.Quit End If End Sub

وهذا ملف به كود انتهاء الصلاحية وتوقف الملف عن العمل فى 15/07/2018 نهاية صلاحية ملف.xlsm

تفضل اخى الكريم -1مناداة الصف الأول دور ثان 2018.xls

اما انا ، فاستعمل الطريقة التالية في برامجي ، واضع كل شيء في الماكرو autoexec ، واذا لم يصلك الخبر بعد ، فانا لا استعمل النماذج المنبثقة في برامجي ، إلا نادرا : وكلمة سر النموذج هو 1234 جعفر

هذه المعادلة البسيطة في الخليةC2 وتسحب نزولاُ =$B2&"/"&$A2

تفضل الملف مرة اخرى-حاول هذه المرة فهو يعمل عندى -1توزيع عشوائى للموظفين.xlsm

قم بتغيير مصدر الكومبوبوكس الى استعلام وبها كل الحقول المطلوبة وفي محرر الاكواد عند تغيير الكومبوبوكس استخدم هذا الكود ME.X1 = ME.EmployeeName.Column(3) غير الرقم 3 الى رقم الحقل المطلوب الرقم 3 هو حقل رقم 4 في الاستعلام اذا تتغيره الى رقم 0 هو رقم حقل الاول في الاستعلام واذا ما فهمت ما هو قصدي تقدر تبحث عن المنتدى بها مثال كتير على ذلك او ارفق نسخة مصغرة من قاعدة بياناتك لكي نعمل تعدديل عليه

وعليكم السلام -اهلا بك اخ كريم فى المنتدى عليك أولا قبل طرح سؤالك ان تستخدم خاصية البحث فى المنتدى -فربما يكون سؤالك قد عرض مسبقا فإليك هذا الرابط يمكنك تتبعه بارك الله فيك :

السلام عليكم المطلوب / 1-تطوير الملف المرفق باستخدام الاكواد واليوزر فورم بدلا من المعادلات . فكرة تصميم البرنامج هي المرحلة الأولـى من (2017/07/01 الي 2018/06/30) رسوم 100 ريال على كل واحد من افراد الاسرة شهريا المرحلة الثانيـة من (2018/07/01 الي 2019/06/30) رسوم 200 ريال على كل واحد من افراد الاسرة شهريا المرحلة الثالثـة من (2019/07/01 الي 2020/06/30) رسوم 300 ريال على كل واحد من افراد الاسرة شهريا. المرحلة الرابعة من (2020/07/01 الي 2030/06/30) رسوم 400 ريال على كل واحد من افراد الاسرة شهريا برنامج حساب المقابل المالي للمرافقين (1).rar

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

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

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