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

فورم حضور وانصراف عاملين واذن خروج ودخول الفيديو الصور الملفات عدد 2 فى صفحة واحدة وفى 4 صفحات حضور وانصراف عاملين واذن خروج ودخول.rar حضور وانصراف العاملين.rar

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

تفضل التموذجين ثابتين في مكانهما و عند إغلاق نموذج يغلق معه النموذج الآخر شاشة نموذجي القراءة والاقتباس من الكتب2.rar

السلام عليكم أو هذه المعادلة: =TRIM(MID(A1;IFERROR(FIND("-";A1;1)+1;1);9^9)) بن علية حاجي فصل.xlsx

وعليكم السلام 🙂 رجاء مراجعة هذا الرابط جعفر

سامحونا لقد أثقلت عليكم الآن كيف يمكن أن نقوم بتسجيل الأداة دون عملية نقل الملف إلى مجلد system32 إذا كان الملف المراد تسجيله موجود بنفس مسار قاعدة البيانات وهذا هو الحل Private Sub أمر6_Click() sFileName = CurrentProject.Path & "\YsVedPic.OCX" RegisterFile (sFileName) End Sub تسجيل أداة أكيف أكس.rar

السلام عليكم تفضل هذا المرفق وضعت به زرين أحدهما لتسجيل الأداة و الآخر لحذف التسجيل كل ما عليك فعله هو وضع الأداة في مجلد system32 ثم افتح البرنامج و اضغط على زر تسجيل الأداة تسجيل أداة أكيف أكس.rar

مرحبا اخ @حلبي تم عمل الكود خلف زر حفظ وفقط يعدل السجلات التي لم تاخذ رقم لانه ممكن تدخل 10 سجلات بعد تضغط حفظ او حفظ بعد كل سجل تم عمل الترقيم عن طريق الاستعلام وبالاستعلام query1 بالتوفيق الاسبقية لرقم المقابلة.accdb

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

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

من المعروف ان الدالة Match تعطينا أول صف تراه في الجدول لكن بحيلة بسيطة يمكننا التغلب على هذه الدالة لتعطينا كل الصفوف (كل ذلك دون أخطاء N/A#) شاهد هذا الملف Multi_Match.xlsx

السلام عليكم أهلا ومرحبا أخي الكريم إستعنت بكود تفقيط عربي لأستاذنا الجليل عبد الله باقشير ستتعرف علي الكود وعلي المعادلات الجديدة المضافة للملف وكل ماهو بالفونط الأزرق حتي أنه كان عندك خطأ في العام (كتبت 2018 بدلا من 2019) في الخلية C16 بالورقة2 وكذلك أي خلايا بها عوامل مساعدة ستجدها بالأزرق أيضا بالجزء الرمادي بالورقة أرجو أن يكون المرفق هو ماتريد تفضل تصفيه_مستحقات.xlsm

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

احسنت استاذ وبارك الله بيك

احسنت ومجهود رائع بس عندي ملاحظة بسيطة على كشف الحساب اتمنى عند تسديد اي مبلغ ان ينزل من المبلغ الرئيسي يعني 5 مليون تصبح 4900 الف ثم 4800 الف وهكذا تحياتي وتقديري

بارك الله فيك استاذى الكريم عمل ممتاز جعله الله فى ميزان حسناتك

هذه المعادلة =IF(ISNUMBER(FIND("-",A2)),REPLACE(A2,1,FIND("-",A2),""),A2)

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

مجهود رائع استاذ عبد اللطيف جزاك الله خيرا

السلام عليكم وحل آخر بالمعادلات... بن علية حاجي الملف.xlsx

ربما كان المطلوب الكود Option Explicit Sub fil_data() Dim S_rg As Range Dim I%, m% Dim st1$, st2$ Range("g3", Range("g4").End(4)).Resize(, 4).ClearContents Set S_rg = Range("b3", Range("b4").End(4)).Resize(, 4) For I = 1 To S_rg.Rows.Count If S_rg.Cells(I, 4) <> "مشطب" Then If S_rg.Cells(I, 3) & S_rg.Cells(I, 4) <> "3 جامعي" & "ناجح" Then Cells(m + 3, "G") = S_rg.Cells(I, 1) Cells(m + 3, "H") = S_rg.Cells(I, 2) Select Case S_rg.Cells(I, 3) & S_rg.Cells(I, 4) Case "1 جامعي" & "معيد": st1 = "1 جامعي": st2 = "نعم" Case "1 جامعي" & "ناجح": st1 = "2 جامعي": st2 = "لا" Case "2 جامعي" & "معيد": st1 = "2 جامعي": st2 = "نعم" Case "2 جامعي" & "ناجح": st1 = "3 جامعي": st2 = "لا" End Select Cells(m + 3, "I") = st1: Cells(m + 3, "j") = st2 m = m + 1 End If End If Next End Sub الملف مرفق jama3i.xlsm

وعليكم السلام 🙂 ماشاء الله ، مادام كل الشباب مشاركين ، فانا ادلو بدلوي كذلك 🙂 و جعفر

السلام عليكم إليك طريقة لتشغيل ملف صوتي مع الأكسس ضع هذا الكود في وحدة نمطية جديدة Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long اجعل اسم الملف الصوتي ringin و صيغته Wav و ضعه في في مجلد البرنامج و ضع هذا الكود خلف زر أمر Dim x2 As String x2 = (Application.CurrentProject.Path & "\ringin.wav") If apisndPlaySound(x2, 1) = 1 Then End If و هذا مثال لا أعرف مصدره تشغيل ملف صوتي بالأكسس.rar

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

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

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

الاخ هانى نزلت لك الملفين على الرابط التالى

احسنت يا استاذ عبد اللطيف روعة من روائعك

حل فى منتهى الروعة جزاكم الله خير

بارك الله فيك أستاذ علي ولإثراء الموضوع يمكن باستخدام دالة if نتيجة الرابع والخامس والسادس.xlsm

اية الجمال والعظمة والمرونة ده ربنا يكرمك والف شكر على تعبك وسرعه ردك

شكرااااااااا

الشكر موصول لك اخي عمر اتشرف باشتراكي في هذا المنتدي الرائع الذي منحني الفرصة للتعرف علي اخوة واصدقاء فضلاء لا يبخلون بما منحهم الله من علم وانت واحد من هؤلاء الفضلاء فتقبل تحياتي

@عبد اللطيف سلوم سأقوم بتحميل الملف والرد عليه ان شاءالله بعد تجربته

@ابو اشرف سلوم بعد التطبيق الملف رائع جدا بارك الله فيك بانتظار جديدك

وعليكم السلام اخى الكريم -نورت المنتدى تفضل سحب الدالة.xlsx

هناك موضوع أكثر أهمية في هذا الملف حيث تستطيع اختيار المرتبة التي تشاء (ليس الخامسة فقط بل الرابعة مثلا أو السابعة) تضع المرتبة التي تريد في الخلية E2 المعادلات في الملف محمية لعدم العبث بها عن طريق الخطأ Choose_grade.xlsm

وعليكم السلام-تفضل نتيجة الرابع والخامس والسادس.xlsm

السلام عليكم أولا : المعادلة في الخلية E5 هي: =DATE(année;INDEX(COLONNE(A:L);EQUIV(mois;MonthsNames;0));1) وبالإنجليزية: =DATE(année;INDEX(COLUMN(A:L);MATCH(mois;MonthsNames;0));1) والتي يمكن اختصارها على الشكل التالي: =DATE(année;EQUIV(mois;MonthsNames;0);1) وبالإنجليزية: =DATE(année;MATCH(mois;MonthsNames;0);1) مما يعني أن الجزئية (INDEX(COLONNE(A:L غير ضرورية في المعادلة... والمعادلة استعملت فيه الدالة DATE والتي تحتاج إلى ثلاثة وسائط بالترتيب التالي : 1- رقم السنة (وفي المعادلة تعطيه التسمية année، ثم 2- رقم الشهر الذي تعطيه الجزئية (EQUIV(mois;MonthsNames;0 أي رقم ترتيب اسم الشهر بالتسمية mois في قائمة الشهور بالتسمية MonthsNames، ثم 3- رقم اليوم وفي المعادلة هو رقم 1 أي في الأخير المعادلة ككل تعطي تاريخ أول يوم من الشهر في الخلية B7 والعام في الخلية B10... ثانيا : المعادلة في F5 : =SI(E5="";"";SI(MOIS(E5+1)>MOIS($E$5);"";E5+1)) وبالإنجليزية: =IF(E5="";"";IF(MONTH(E5+1)>MONTH($E$5);"";E5+1)) المتعلقة بالخلية E5 هي عبارة عن IF الدالة الشرطية (بشرطين) : الشرط الأول إذا كانت الخلية E5 فارغة تكون الخلية F5 فارغة أما إذا كانت الخلية E5 غير فارغة فإن الدالة تتحقق من الشرط الثاني الذي هو : (mois(E5+1)>mois(E5 أي إذا كان شهر (التاريخ في E5 بإضافة 1 يوم له) أكبر من (شهر تاريخ الخلية E5) فإن الخلية F5 تبقى فارغة، وإذا لم يكن كذلك فإن الخلية F5 يكون فيها تاريخ اليوم الذي يلي تاريخ الخلية E5 من الشهر نفسه... والله أعلم في الملف المرفق تم تعديل آخر بحيث أدرجت أعمدة لكل الشهور مع إضافة بعض النطاقات بالتسمية (للضرورة) مع كود بسيط وُضع في حدث الورقة (الشيت) يقوم بإظهار جدول الشهر المختار في الخلية B7 وإخفاء جداول كل الشهور الأخرى... وهذا تسهيلا لأرشيف الشهور مما يفيد في العمليات الإحصائية الشهرية أو السنوية... بن علية حاجي absenses.xlsm

السلام عليكم جميعا... الحمدلله تم انتهائى من تصميم برنامج الاقساط هذا واللذى يقوم بمراقبة وسداد الاقساط ونبذة عن البرنامج هو مجانى بداية ثم يحتوى هذا البرنامج على فورم دخول بكلمة مرور وهى (12345) ويحتوى على عدة صفحات منها الرئيسية ومنها العملاء ليتم تسجيل بيانات العملاء فيها ومنها حالة العملاء وهى صفحة يتم مراقبة حالة السداد للعملاء ولكن الحالات هى اوشك اى على السداد اذا مر27يوم من تاريخ اخر سداد للعميل ومتاخر اذا مر اكثر من30يوم ومتاخر جدا اذا مر اكثر من 62يوم وغيرذلك ومن هذه الصفحات البحث والترحيل وفيها تقوم بالبحث عن العميل باى حرف من اسمه او من السلعة المباعة له او عنوانه او ان كان ضامن له ويتم السداد هناك و تستطيع تغيير القيمة الافتراضية للقسط الشهرى يدوى ويتم الاحتساب على ذلك ومنها صفحة عمليات السداد التى قام العميل بتسديدها وتستطيع التعديل فى اى بيانات فهى قابلة للتعديل صفحة استعلام مختصر وتكون ب البحث بالكود يتم جلب كل عمليات العميل اول حسابه والمتفق عليه والمسدد ومتى ينتهى حسابه وكم سدد والقيمة المسددة والمتبقية وهى غير قابلة للتعديل ومن هذه الصفحات صفحتين فارغتين ليقوم المستخدم باستخدامهما كيف يشاء ومنها صفحة كلمات المرور والصلاحيات وهذه تقوم بالتعديل على كلمات المرور واعطاء صلاحيات الدخول لكل مستخدم وتم تحديد ثلاثة اشخاص المدير و2موظف وهناك تستطيع ان تكتب اسم المنشأة ليظهر بالرئيسية وايضا اسم المستخدم يظهر بالرئيسية واسم المدير وفى صفحة كلمات المرور تقارير بسيطة وايضا فيها تم ذكر بعض المقربين الى قلبى من الاساتذة الافاضل بروابط صفحات الفيس الخاصة بهم فهم اصحاب الفضل على من بعد الله... هذا والحمدلله واخيرا الدال على الخير كفاعله انشر الخير يمكن غيرك محتاج ولا تدرى ولا أسالكم الا الدعاء فى ظهر الغيب وعذرا على الاطالة والسلام عليكم ورحمة الله وبركاته برنامج الأول للاقساط...عمر جاد ابونصار.xlsb.zip عذرا على الاطالة لكن بينت فيها كيفية العمل على البرنامج حتى لا اجهد المستخدم

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

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

اليك هذا لا اعرف من هو صاحبه لذلك ادعوا له اخفاء رسالة بعد عدد ثواني.mdb

اخي الفضل هذا الموقع فيه كل ما تريد https://www.mutaz.net/free-programs/

وعليكم السلام هذه 6 طرق ، برسائل وبدون ، وانا اخترت لك آخر واحدة منها ، وهي تعطيك شريط في اسفل شاشة الاكسس: . Option Compare Database Private Sub أمر10_Click() On Error GoTo Err_أمر10_Click 'Dim stDocName As String 'stDocName = "q1" 'DoCmd.OpenQuery stDocName, acNormal, acEdit '1 العمل بصمت وبدون اشعارات ' CurrentDb.Execute ("q1") '2 العمل بصمت وبدون اشعارات ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True '3 العمل بصمت وبدون اشعارات ، ولكن بوجود ساعة ترابية تشير الى وجود عمل ' DoCmd.Hourglass True ' DoCmd.OpenQuery "q1" ' DoCmd.Hourglass False '4 عمل اشعار ثابت لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' Application.Echo True ' Application.Echo False, "الاستعلام يقوم بالتحديث" ' ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' Loop ' ' Application.SetOption "Show Status Bar", False ' Application.Echo True '5 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة ' Application.SetOption "Show Status Bar", True ' SysCmd acSysCmdSetStatus, "الاستعلام يقوم بالتحديث" ' DoCmd.SetWarnings False ' DoCmd.OpenQuery "q1" ' DoCmd.SetWarnings True ' ' PauseTime = 3: Start = Timer ' Do While Timer < Start + PauseTime ' DoEvents ' A = A + 1 ' If A / 50 = Int(A / 50) Then B = B & " . " ' SysCmd acSysCmdSetStatus, B & "الاستعلام يقوم بالتحديث" ' Loop ' Application.SetOption "Show Status Bar", False ' SysCmd acSysCmdClearStatus '6 عمل اشعار متغير لمدة 3 ثوان في اسفل الشاشة Application.SetOption "Show Status Bar", True SysCmd acSysCmdInitMeter, "الاستعلام يقوم بالتحديث", 5000 DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True PauseTime = 3: Start = Timer Do While Timer < Start + PauseTime DoEvents A = A + 1 SysCmd acSysCmdUpdateMeter, A Loop Application.SetOption "Show Status Bar", False SysCmd acSysCmdClearStatus Exit_أمر10_Click: Exit Sub Err_أمر10_Click: MsgBox Err.Description Resume Exit_أمر10_Click End Sub . وهذا الرابط فيه البرنامج المرفق ، يعني خذ منه الكود وخليه في برنامجك : http://www.access-programmers.co.uk/forums/attachment.php?attachmentid=32438&stc=1&d=1275923825 . . والنتيجة Notification بطريقة البرامج المحترفة ، فوق ساعة الكمبيوتر . جعفر 876.msg styles.mdb.zip BalloonToolTipSample.mdb.zip

اخي الفاضل ليس معطوب نزل اخر اصدار winrar هذة الرساله DoCmd.Beep If MsgBox(" هــل تـريـد نــســخ الاسـمـاء إلـى قـاعـدة الـعـمـلاء " & vbCrLf & "", vbYesNo, " بـرنـامـج الـخـيـاط ") = vbYes Then Dim strSQL As String DoCmd.SetWarnings False DoCmd.OpenQuery "q1" DoCmd.SetWarnings True Beep MsgBox " تـم نــســخ الاسـمـاء إلـى قـاعـدة الـعـمـلاء بـنـجـاح", vbInformation, " بـرنـامـج الـخـيـاط "

السلام عليكم الاخ الكريم / على حسن بارك الله فيك وبعد رد اخي الحبيب جدا / سليم حاصبيا ... جزاه الله خيراً ارجو اضافة ولو معلومة علها تفيدك عن انواع امتدادات الاكسيل اليك اخي الكريم ... كل امتدادت الاكسيل والفرق بينهم ( راجعهم واختار ما يناسبك منهم ) XLS تستطيع قرائتها بالإكسل 2003 XLS تستطيع الإحتفاظ بالكود فيها بداية من أوفيس 2007 ، تم استبدال XLS بثلاث إمتدادات xlsb ، xlsx ، xlsm وثلاثتهم لايستطيع الأوفيس 2003 قرائتهم إلا بإضافة أداة جديدة إضافية 1- الإمتداد xlsx لحفظ ملفات الإكسل العادية التي لاتحتوي علي أكواد ، فإن كتبت كود وحفظت الملف بهذا الإمتداد ولم تنتبه لرسالة التنبيه وأغلقت الملف ، فلن تجد الكود مرة أخري عند الفتح 2- الإمتداد xlsm لحفظ ملفات الإكسل التي تحتوي علي أكواد 3- الإمتداد xlsb لحفظ ملفات الإكسل (مع أكوادها) ، ولكن لاتستطيع عمل مشاركة لهذا النوع من الملفات للعمل بأكثر من مستخدم علي الملف في الشبكة ، أي Share ودائما ننصح باستخدام xlsb بدلا من xlsm لقلة حجم هذا النوع الملحوظة بالنسبة للآخرين (( إلا في حالة مشاركة الملف علي الشبكة )) ارجو ان اكون قد افدتك ولو قليلا تقبل خالص تحياتي

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة تذكير بتاريخ الإنتهاء من خلال الفورم تم ارفاق الكود من الاستاذ / ابو القبطان و تعديل المبدع / ياسر خليل أبو البراء و لا تنسونا من صالح الدعاء تحياتى تذكير بموعد التحصيل.rar

اخى الحبيب نزل الملف التالى عله يفيدك http://www.mediafire.com/download/1tkrlz371wmuhse/%D8%AA%D8%AD%D9%84%D9%8A%D9%84+%D8%A7%D9%84%D8%A8%D9%8A%D8%A7%D9%86%D8%A7%D8%AA+%D9%88%D8%A7%D8%B9%D8%AF%D8%A7%D8%AF+%D8%A7%D9%84%D8%AA%D9%82%D8%A7%D8%B1%D9%8A%D8%B1+%D8%A8%D8%A7%D8%B3%D8%AA%D8%AE%D8%AF%D8%A7%D9%85+%D8%A7%D9%84%D8%A7%D8%AF%D8%A7%D8%A9+Power+Pivot+for+Excel+2010.rar

السلام عليكم يتم استخراج البيانات لكل القيم الفريدة في العمود بي للورقة Data1 Option Explicit Private Const ContColmn As Integer = 5 '====================================================== '====================================================== Sub kh_Report() Dim obj As Object Dim Ar() As Double, XX() As Double, X() As Double Dim v As Double, vv As Double Dim Rng As Range Dim LastRow As Long, iCont As Long Dim i As Long, ii As Long, iii As Long, R As Long Dim C As Integer Dim tx '''''''''''''''''''''' On Error GoTo kh_ex Set obj = CreateObject("Scripting.Dictionary") ''''''''''''''''''''' '============================================ kh_Clear '============================================ With æÑÞÉ2 LastRow = .Cells(Rows.Count, "A").End(xlUp).Row Set Rng = .Range("A1:D" & LastRow) End With '============================================ ReDim Ar(1 To ContColmn - 1) For C = 1 To ContColmn - 1 Ar(C) = Range("B1").Cells(1, C).Value Next tx = Range("F1").Value '============================================ kh_Application False With Rng .Sort .Columns(2), xlAscending For i = 1 To .Rows.Count v = .Cells(i, "B").Value vv = Val(.Cells(i, "D")) If obj.Exists(v) Then iii = obj(v) '''''''''''''''''' If .Cells(i, "C").Value = tx Then For C = 1 To ContColmn - 1 If .Cells(i, "A").Value = Ar(C) Then XX(C + 1, iii) = XX(C + 1, iii) + vv Next End If Else ii = ii + 1 ReDim Preserve XX(1 To ContColmn, 1 To ii) obj.Add v, ii '''''''''''''''''' XX(1, ii) = v If .Cells(i, "C").Value = tx Then For C = 1 To ContColmn - 1 If .Cells(i, "A").Value = Ar(C) Then XX(C + 1, iii) = vv Next End If End If Next End With ''''''''''''''''''''''''''''''' iCont = obj.Count If iCont Then Erase Ar ReDim Ar(1 To ContColmn - 1) ReDim X(1 To iCont, 1 To ContColmn) For i = 1 To iCont X(i, 1) = XX(1, i) For C = 1 To ContColmn - 1 Ar(C) = Ar(C) + XX(C + 1, i) X(i, C + 1) = Ar(C) Next Next With Range("A2").Resize(iCont, ContColmn) If iCont > 1 Then .Rows(1).AutoFill .Cells, xlFillFormats .Value = X End With ''''''''''''''''''''''''' End If '============================================ kh_ex: kh_Application True '''''''''''''''''' '''''''''''''''''' '''''''''''''''''' Set obj = Nothing Set Rng = Nothing Erase XX, X, Ar '''''''''''''''''' If Err Then MsgBox "Err.Number : " & Err.Number Err.Clear End If End Sub شاهد المرفق 2010 Ex1.rar