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

السلام عليكم تفضل تم عمل اللازم البيانات كثيرة جدا لذا ستلاحظ الوقت الذي يستغرقه تنفيذ الكود Private Sub zer1_Click() On Error Resume Next DoCmd.Hourglass True Dim rs1 As Recordset Dim rs2 As Recordset Dim i, ii, iii As Long Dim r As Integer Dim rr As Integer Set rs1 = CurrentDb.OpenRecordset("SELECT Students.Group FROM Students GROUP BY Students.Group ORDER BY Students.Group") Set rs2 = CurrentDb.OpenRecordset("SELECT Students.sery, Students.Group, Students.kolaf, Students.mazroof FROM Students ORDER BY Students.Group") rs1.MoveLast: rs1.MoveFirst rs2.MoveLast: rs2.MoveFirst For i = 1 To rs1.RecordCount r = rs1!Group For ii = 1 To rs2.RecordCount rr = rr + 1 For iii = 1 To 50 If rs2!Group = r Then rs2.Edit rs2!kolaf = rr rs2.Update rs2.MoveNext End If Next iii Next ii rr = 0 rs1.MoveNext Next i DoCmd.Hourglass False MsgBox "تم التوزيع بنجاح" Set rs1 = Nothing Set rs2 = Nothing End Sub Private Sub zer2_Click() On Error Resume Next DoCmd.Hourglass True Dim rs1 As Recordset Dim i, ii As Long Dim r As Integer Set rs1 = CurrentDb.OpenRecordset("SELECT Students.sery, Students.mazroof FROM Students ORDER BY Students.sery") rs1.MoveLast: rs1.MoveFirst For i = 1 To rs1.RecordCount Step 50 r = r + 1 For ii = 1 To 50 rs1.Edit rs1!mazroof = r rs1.Update rs1.MoveNext Next ii Next i DoCmd.Hourglass False MsgBox "تم التوزيع بنجاح" Set rs1 = Nothing End Sub رقم الغلاف والمظروف2.rar

ضع هذا الكود تحت امر موافق CurrentDb.Execute "INSERT INTO ts SELECT * FROM tf", dbFailOnError

من الملفات القديمة التي تمت مشاركتي لها والتي تطلب غالباً كيف نحمي الخلايا غير الفارغة بواسطة باسوورد (الباسورد في الملف / الخلية H3/ يمكن حفظة و مسحه عن عيون الفضوليين) مع حرية الغاء الجماية كما تشاء protect non empty data with Pass word.xlsm

والله اخى @ابوخليل حاولت افعلها ولكنها لم تنجح معى لعملي انها سوف تحتاج الى مكتبة Recordset فاذا كان لديك قليلاً من الوقت لشرحها هى وادواتها اكون لك شاكراً .

بعد إذن استاذنا جعفر والاخ محمد يمكنك فتح التقرير بكامل الشاشة بوضع هذا السطر في حدث عند الفتح DoCmd.Maximize ::بالتوفيق::

وهي تجربتي 100% كذلك ، ولعدة اسباب فانا استعمل نوعين من الماكرو فقط ، ماكرو ليفتح عند فتح البرنامج ، ويجب ان يكون اسمه autoexec ، والماكرو الآخر هو لوقف اسخدام ازرار الكيبورد للدخول في الكود وقائمة كائنات البرنامج ، اما بقية برامجي فاستخدم VBA هذه ليست رموز ، انما لأنك كاتب اسم النموذج بالعربي (ونحن دائما نقول: يجب ان تكتب اسماء الكائنات جميعها بالانجليزية ، الجداول والنماذج والاستعلامات والتقارير والماكرو ، واسماء الحقول) ، فالبرنامج كتب ارقام الحروف بالـ ascii code ، ولم يستعمل الامر chr بسبب استعمالك للحروف العربية ، فإستخدم chrW ومن الرابط المرفق تحصل على ارقام الحروف العربية ، مثلا ChrW(1608) = و http://sites.psu.edu/symbolcodes/languages/mideast/arabic/arabicchart/ جعفر

الأخوة الأعزاء ، السلام عليكم هـذه بعض الأشكال الجديدة والتي يمكن إضافتها للأشكال الموجودة في البرنامج. للإضافة ، عليكم فك الضغط ونسخها في ملف My Shapes في My Documents اتمنى الإستفادة للجميع people_shapes_2007.zip people_shapes_2002.zip Veritas.zip

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

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

السلام عليكم ورحمة الله وبركاته بسبب وقتي الضيق هذه الايام ، فانا انزور المنتدى في الليل فقط البارحة اشتغلت على البرنامج ، ولكن جزئية بسيطة منه لم تشتغل ، فنظرت في البرنامج الليلة ، واذا بأخوي ابو خليل قد وضع اجابته فكنت سأتوقف عن العمل ، ولكن ملاحظته عن سرعة البرنامج لفت نظري ، واردت ان ارى اذا استطيع ان اتغلب على بطئ العملية ، واعتقد بأني بالفعل توفقت والحمدلله Option Compare Database 'Option Explicit Private Sub cmd_Go_Click() On Error GoTo err_cmd_Go_Click Dim dbs As DAO.Database Dim rst As DAO.Recordset Dim rstG As DAO.Recordset 'الغلاف Z = 1 Set dbs = CurrentDb Set rstG = dbs.OpenRecordset("SELECT Group FROM Students GROUP BY Group ORDER BY Group") rstG.MoveLast: rstG.MoveFirst RCg = rstG.RecordCount For k = 1 To RCg Set rst = dbs.OpenRecordset("Select * From Students Where [Group]=" & rstG!Group & " Order By Sery, Group") 'Set rst = dbs.OpenRecordset("Select * From Students Order By Sery, Group") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount If RC / 50 = Int(RC / 50) Then Groups = RC / 50 Else Groups = Int(RC / 50) + 1 End If Counter = 0 For i = 1 To Groups For j = 1 To 50 Counter = Counter + 1 rst.Edit rst!kolaf = i rst.Update rst.MoveNext Next j 'rst.MoveNext Next i rstG.MoveNext Next k Start_mazroof: rstG.Close: Set rstG = Nothing 'الظرف Z = 2 Set rst = dbs.OpenRecordset("Select * From Students Order By Sery, Group") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount If RC / 50 = Int(RC / 50) Then Groups = RC / 50 Else Groups = Int(RC / 50) + 1 End If For i = 1 To Groups For j = 1 To 50 rst.Edit rst!mazroof = i rst.Update rst.MoveNext Next j 'rst.MoveNext Next i Exit_cmd_Go_Click: rst.Close: Set rst = Nothing: dbs.Close MsgBox "Done" Exit Sub err_cmd_Go_Click: If Err.Number = 3021 And Z = 1 Then Resume Start_mazroof ElseIf Err.Number = 3021 And Z = 2 Then Resume Exit_cmd_Go_Click ElseIf Err.Number = 3052 Then Resume Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر رقم الغلاف والمظروف.zip

بارك الله فيك هذا هو المطلوب تماما شكرا جزيلا

بعد اذن اخي علي هذه المعادلة =CHOOSE((SUM($F$4:$F$5)>=10000)+1,50,SUM($F$4:$F$5)*0.05)

بارك الله فيك اخي الكريم هذا ماطلبته شكرا على المساعدة

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

السلام عليكم اخي الكريم من خلال نظرة سريعة للكود هناك خطأ بسيط وهو ان الامر if يحتاج الى انهاء هذا الامر ب end if

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

وفقكم الله ‏أسباب دفع العقوبة عشرة، وهي: 🔹ثلاثة من العبد: - التوبة - الاستغفار - الحسنات الماحية 🔹ثلاثة من الناس: - دعاءالمؤمنين - إهداءالعمل الصالح له - شفاعتهﷺ 🔹أربعة يبتديها الله: - المصائب المكفرة في الدنيا - الفتنة في البرزخ - أهوال القيامة - مغفرة الله بفضله

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

قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف

جزاك الله خيرا أستاذ سليم حاصبيا نعم هذا هو المطلوب

بارك الله فيك أستاذ سليم

ربما كان المطلوب aamir_cod_form.xlsm

كل الشكر والتقدير والاحترام للاخ والاستاذ الخبير jjafferr معلومة لم اكن اعرفها من قبل بخصوص هذه الرموز التي تظهر في الماكرو وبفضلك تعرفت عليها الان .... قال الرسول محمد (ص) (( زكات العلم تعليمه )) اللهم يجعلك من المزكين ويحفظك من كل مكروه .. شكري وتقديري للاخ عبد اللطيف واعتذر عن المعلومة

تفضل جرب هذا توزيع عشوائى للموظفين.xlsm

وعليكم السلام النموذج معطوب ، فلا يمكنك الاستفادة منه ، لذا عملت لك نسخه من كائناته في نموذج جديد بإسم PaymentEach ، ولكن للعلم ، قد تكون احد كائنات النموذج هي السبب في جعل النموذج معطوب ، فالافضل ان تعمل النموذج من جديد!! استطعت/تستطيع فتح النموذج القديم هكذا: نموذجك اسمه PaymentEach_OLD ، لما تنقر عليه مرتين تحصل على هذه الرساله (انا عملت ماكرو بإسم تكبير والذي كان يطلبه البرنامج ،وطلبت منه يعطين هذه الرساله) : . سينفتح النموذج ، ثم انقر بالفأرة اليمين ، فتحصل على هذه الرسالة . انقر ok ، وستحصل على القائمة التالية ، فإنقر على Design view . فينفتح لك النموذج في وضع التصميم . وكما اخبرتك ، فإنه معطوب ولا تستطيع استعماله ، وانما استعمل النوذج الآخر الذي عملت لك. جعفر dd.zip

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

بعد إذن أخينا العزيز شيفان يمكنك استعمال هذا الاستعلام SELECT B FROM Tab1 WHERE B NOT IN(SELECT A FROM tab1);

اتفضل اليك ما طلبت Officna.mdb

نعم اخي برمجة VBA افضل بكثير من الماكرو وهذا راي الشخصي وعن تجربة

تفضل اخى الكريم لك ما طلبت معادلة-1.xlsx

بارك الله فيك استاذ سليم

السلام عليكم من باب المشاركة فقط ردا علي أخونا khalid2117 السنة الكبيسة ليست بصفة عامة صحيح تقبل القسمة علي 4 لكن لها استثناء إن كانت تقبل القسمة علي 100 ، مثلا 2100 - 2200 - 2300 كلها سنوات بسيطة ، فبراير بها 28 يوم وليس 29 وهذا الاستثناء له استثناء وهي السنوات تقبل القسمة علي 400 فهي كبيسة أي أن فبراير بها 29 مثل 2400 - 2800 ويرجع هذا إلي أن السنة بالضبط لاتساوي 365.25 يوم كما هو شائع بل إنها 365.2422

سلمت يداك

من باب المشاركة وإثراء المعلومة أيظاً السنة الكبيسة هي التي يكون باقي القسمة على 4 =0 بمعنى آخر التي تقبل القسمة على 4 مثال 2016 - 2020 =IF(MOD(Year;4)=0;29;28)

بسم الله الرحمن الرحيم الحمد لله رب العالمين والصلاة والسلام على اشرف المرسلين سيدنا محمد وعلى اله وأصحابه اجمعين بفضل الله وكرمة انتهيت من تطوير برنامج المصروفات الاصدار الثالث . وقد تم هذا التطوير بناء على رغبة الكثيرون والجديد فيه -زيادة عدد الحسابات الى 100 حسابات وزيادة عدد حركات التسجيل الى الضعف - امكانية عرض تقرير مصروفات لقسم معين ولفتره معينه - امكانية عرض تقرير سنوي - عمل نسخة احتياطيه للبرنامج تم عمل حماية للملف حفاظا على المعادلات والصيغ من التلف والباسورد 12345 ارجو من كل من يستفاد من هذا البرنامج نشره ومشاركته للجميع فزكاة العلم نشره الاصدارت السابقه الاول والثانى على على هذا الرابط http://www.officena.net/ib/index.php?showtopic=54319&hl= برنامج المصروفات الاصدار الثالث.rar

اتفضل طلب حضرتك لكن مش مرتبط كل اسم باى عنصر تحكم لو حضرتك عاوز تحفظ كل ترجمة على حده اعمل اسم لكل واحد فى الجدول على حده واربط بيها العناصر translation_name-up.rar