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

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

بارك الله بك أخ علي لكني أفضل هذه المعادلة في حال ادراج نص أو رقم سالب او كانت الخلية فارغة (يظهر فراغ) =IF(N(A2)<=0,"",YEAR(INT(A2)))

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

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

السلام عليكم تستطيع دائما تفكيك اي معادلة لفهمها لاحظ أن نظام الجهاز عندي يضع بالمعادلة علامة (,) بدلا من (;) المعادلة السابقة بعد تفكيكها تكون كالتالي =IFERROR(A,) حيث نستعيض بالمعامل A عن المعادلة SUMPRODUCT((INDEX(ACH.!$B$3:$AP$9999,MATCH(A3,ACH.!$A$3:$A$9999,),)>0)*COUNTIF(INDEX(IP!$C$4:$N$44,,IFERROR(MATCH(C3,IP!$E$2:$N$2,)+2,MATCH(E3,IP!$C$3:$D$3,))),ACH.!$B$1:$AP$1)) ومعني المعادلة الأولي أن في حالة حدوث خطأ من المعادلة A فلا تكتب النتيجة خطأ والآن إلي المعادلة A بنفس الطريقة نبسطها كالتالي A= SUMPRODUCT(B*C) حيث B=(INDEX(ACH.!$B$3:$AP$9999,MATCH(A3,ACH.!$A$3:$A$9999,),)>0) ، C=COUNTIF(INDEX(IP!$C$4:$N$44,,IFERROR(MATCH(C3,IP!$E$2:$N$2,)+2,MATCH(E3,IP!$C$3:$D$3,))),ACH.!$B$1:$AP$1) ومعني ذلك ببساطة أن A تساوي حاصل ضرب مصفوفتين B,C مشروطتين والمصفوفة B هي أيضا يمكن تبسيطها هكذا B=(INDEX(B1,B2,)>0) حيث B1 هي المجال ACH.!$B$3:$AP$9999 ، B2 هي المعامل الناتج عن MATCH(A3,ACH.!$A$3:$A$9999,) و لإيجاد المعامل B2 نذهب للورقة ACH في المجال A3:A9999 والذي يبدأ بالخلية A3 لتبحث عن كود العميل والموجود بالخلية A3 بالورقة QSC ، إذن ستجد أنه في الصف الثامن (إذا بدأت العد من الخلية A3 ) أي أن : الجزء الأخير من المصفوفة B والذي أسميناه B2 سيأتي بالرقم 8 إذن المصفوفة B هي عنصر ناتج من المجال B1 (أي المجال B3:AP9999 في الورقة ACH) وهو العنصر الثامن وحيث أن رقم العمود لم يذكر فيكون الناتج هو كامل الصف الثامن من المجال B3:AP9999 في الورقة ACH وبما أن وحيث المجال B3:AP9999 يحتوي علي 41 عمود من (B) إلي (AP) إذن نتوقع أن يكون العنصر الثامن هذا هو محتوي 41 خلية وبالرجوع لها تجدها (1 , 0 , 1 , 0 , 1 , 1 , 0 , 6.25 , 1 , 2 , 2 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 1 , 1 , 0 , 1 , 0 , 0 , 0 , 0 , 1 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0) بالترتيب حيث يعتبر الخلايا الفارغة أصفار باقي معني أخير بالمصفوفة B وهي مقارنة العناصر الناتجة بالرقم 0 (حيث آخر مقطع منها هو >0) فالناتج النهائي لها سيكون 41 عنصرا كل منها يحتوي علي 1 إذا كان الأصلي أكبر من 0 ويحتوي علي 0 إذا كان الأصلي ليس أكبر من 0 الناتج النهائي لها سيكون هكذا (1 , , 1 , , 1 , 1 , , 1 , 1 , 1 , 1 , , , , , , , , , , , , , 1 , 1 , , 1 , , , , , 1 , , , , , , , , , ) والمعني الطبيعي لهذا هو جعل الإكسل ينتقي عدد المرات (الأصناف) التي أخذها هذا العميل والآن : المصفوفة C هي ..... هكذا بنفس الوسيلة تجد أنها أيضا تنتج 41 عنصرا من الورقة الأخيرة IP وهذه العناصر رأسية (SKU CODE) ولابد أن تتساوي في العدد مع عناصر المصفوفة الأولي أي 41 عنصرا حقيقة أنا لا أعلم ماذا يعني SKU CODE ولكن تقاطع المصفوفتين سينتج 1 عند التقاطعات المملؤة أي التي بها 1 في المصفوفتين أعتقد أن المعني لهذا هو جعل الإكسل ينتقي عدد المرات (الأصناف) التي أخذها هذا العميل وفي نفس الوقت تتطابق مع هذا ال SKU CODE

هذا الماكرو يقوم بما تريدين اختي الفاضلة Option Explicit Sub lena() If Sheets(1).[c4] = vbNullString Then Exit Sub Dim lr%, lr1% lr = Range("a" & Rows.Count).End(xlUp).Row If lr <= 5 Then MsgBox "No Data to Transfer", 64 Exit Sub End If lr1 = Sheets(Sheets(1).[c4].Value) _ .Cells(Rows.Count, 1).End(3).Row + 2 Sheets(1).Range("a6").Resize(lr - 5, 14) _ .Cut Sheets(Sheets(1).[c4].Value).Range("a" & lr1) End Sub

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

وعليكم السلام 🙂 تفضل: Dim strSQL As String Dim intHow_Many As Integer مشكلة اكثر من معيار ، هي الطريقة الصحيحة في كتابة الصيغة لذلك، خلينا نتعامل مع حقل واحد كل مرة، لنتفادى الخطأ strSQL = "[KararNom]='" & Me.KararNom & "'" 'نعمل اول معيار في المتغير strSQL strSQL = strSQL & " And [KararYear]='" & Me.KararYear & "'" 'نضيف معيار الحقل الثاني strSQL = strSQL & " And [CompID]=" & Me.CompId 'نضيف معيار الحقل الثالث الآن اصبح المتغير strSQL يحتوي على جميع المعايير، وبالصيغه الصحيحة، اذن فالنستعمله في الامر التالي كم عدد السجلات التي يوجد بها هذه المعايير intHow_Many = DCount("*", "TblKararat", strSQL) If intHow_Many > 0 Then اذا كان عدد السجلات اكثر من صفر، فمعناه ان اسم الموظف موجود مسبقا لذا، اوقف العملية واخبر المستخدم، ولا تحفظ السجل MsgBox "لقد تم تسجيل هذا الموظف مسبقا" Exit Sub End If جعفر

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

تفضل الملف دون حماية... بن علية حاجي 1 (1).xlsx

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

السلام عليكم من تجربتي ، وبسبب اختلاف اعدادات الوندوز ولغاته ، توصلت لعمل جدول خاص للاشهر tbl_Months ، ممكن اعدادات الوندوز تظهر الشهر بصيغة December ، او ديسمبر ، او كانون الاول . . ولكنك تريد ان يظهر عندك الشهر بأحد هذه الصيغ ، بغض النظر نظام اي كمبيوتر يعمل عليه برنامجك ، فيمكنك قراءة الطريقة التي تريدها من الجدول ، كما هو واضح في المثال . وهذا الكود كمثال فقط ، عن طريقة مناداة الحقول من الجدول: Private Sub myDate_AfterUpdate() 'display the dates based on the system setting Me.Date_1_System = Format(Me.myDate, "dddd dd/mm/yyyy") Me.Date_2_System = Format(Me.myDate, "dddd dd, mmm yyyy") Me.Day_System = Format(Me.myDate, "dddd") Me.Month_System = Format(Me.myDate, "mmmm") ' 'use the following Functions to get the integer number of: 'Today= 22 December 2017 'Day(Today) = 22 'Weekday(Today) = 6 'Friday 'Month(Today) = 12 'December 'Year(Today) = 2017 ' Me.Day_table_Arabic = DLookup("[Days_Arabic]", "tbl_Months", "[Months_Number]=" & Weekday(Me.myDate)) Me.Day_table_English = DLookup("[Days_English]", "tbl_Months", "[Months_Number]=" & Weekday(Me.myDate)) Me.Month_Table_Georgian = DLookup("[Months_Georgian]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Month_Table_Iraqi = DLookup("[Months_Iraqi]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Month_Table_English = DLookup("[Months_English]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Date_Table_Georgian = DLookup("[Months_Georgian]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Date_Table_Georgian = Day(Me.myDate) & " " & Me.Date_Table_Georgian & " " & Year(Me.myDate) Me.Date_Table_Iraqi = DLookup("[Months_Iraqi]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Date_Table_Iraqi = Day(Me.myDate) & " " & Me.Date_Table_Iraqi & " " & Year(Me.myDate) Me.Date_Table_English = DLookup("[Months_English]", "tbl_Months", "[Months_Number]=" & Month(Me.myDate)) Me.Date_Table_English = Day(Me.myDate) & " " & Me.Date_Table_English & " " & Year(Me.myDate) End Sub وبعدها توسعت في الجدول واستفدت منه لأشياء اخرى جعفر tbl_Months.mdb.zip

امثلة بسيطة ارجوا ان تنفعنا جميعا صيغة الدالة DLookup DLookup(expr, domain [, criteria] )‎ expr( مطلوب) اسم الحقل domain( مطلوبة) اسم الجدول/الاستعلام criteria( اختيارية) الشروط دا مثال بسيط : عازوين نعرف اسم الصنف الذي كوده 15 في جدول الاصناف اسم الجدول : items اسم الحقل الذي يحمل أرقام الاصناف : code_items اسم الحقل الذي يحمل أسماء الاصناف: items_Name كود: MsgBox DLookup("[items_Name]", "items", "code_items=15") ممكن ناخد كود الصنف من مربع نص موجود في نموذج بدلاً من التصريح في الدالة عن كود الصنف لنفترض مثلا أن مربع نص موجودٌ في النموذج باسم txtItemsCode كود: MsgBox DLookup("[items_Name]", "items", "code_items=" & Me.txtItemsCode) ممكن ناخد قيمة كود الصنف من نموذج آخر بس بشرط أن يكون مفتوحاً ، فلو كان txtItemsCode موجود في نموذج آخر باسمfrm1 فإن الكود سيأخذ الشكل التالي : كود: MsgBox DLookup("[items_Name]", "items", "code_items=" & Forms!frm1!txtItemsCode) ملحوظة بالنسبة للشروط يجب أن تأخذ في الاعتبار نوع بيانات الحقل الذي نعتمد عليه في الشرط ، في المثال السابق كان حقل نوع بياناته (رقم) ، فلو كان نوع بياناته (نص) سيكون الكود بالشكل التالي :code_items كود: MsgBox DLookup("[items_Name]", "items", "code_items='" & Me.txtItemsCode & "'") طب لو كان نوع بياناته (وقت/تاريخ) الكود هيبقى كدا كود: MsgBox DLookup("[items_Name]", "items", "code_items=#" & Me.txtItemsCode & "#") وشكر الله لكم جميعا

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

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

تفضل 🙂 وغير MMMM الى اسم حقل الشهر DLookup("[Months_Number]", "tbl_Months", "[Months_Iraqi]='" & [MMMM] & "'") جعفر

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

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

بارك الله فيك اخي واستادي الغالي سليم معادلة وللأروع الله ينورك بالضبط هذا ما ابحث عنه للمعلومة فقط لو اردت النقاط تكون بإما بمثلا 10 او 10.5 يجب عليا تغيير 0.25 ب 0.50 في المعادلة صحيح ام لا

هذه المعادلة في عامود المعدل =IF(COUNTBLANK(D6:G6)=0,CEILING(SUM(D6:G6)/5,0.25),"")

أهلا بك صالح.. أشكرك على متابعتك لحسابي، وأتمنى أن تجد في مشاركاتي على قلتها! شيئاً جديدا

وعليكم السلام ورحمة الله وبركاته أخي الحبيب محمد "أبو جودي" المحترم جزاكم الله خيراً على هذا العمل الرفيع الذي أرجو الله تعالى أن يجعله بميزان حسناتكم أسأل الله العظيم ربّ العرش العظيم أن يشفيك شفاء لا يغادر سقماً اللهم اشف أنت الشافي لا شفاء إلا شفاؤك شفاء لا يغادر سقماً والسلام عليكم ورحمة الله وبركاته

الكود طويل جداً و يحتوي على أكثر من مـرة SELECT & COPY & PASTE هذا الاوامر ترهق الاكسل ولا لزوم لاستعمالها الا عند الضرورة اليك هذا الكود البسبط Option Explicit Sub copy_data() If ActiveSheet.Name <> "Sheet1" Then Exit Sub Dim R%, R1% R = Cells(Rows.Count, 3).End(3).Row + 1 R1 = Range("K5", Range("K4").End(4)).Resize(, 6).Rows.Count Cells(R, 3).Resize(R1, 6).Value = _ Range("K5", Range("K4").End(4)).Resize(, 6).Value Cells(R, 3).Resize(R1, 6).SpecialCells(4) = "EMPTY CELL" End Sub الملف مرفق فقط اضغط الزر للتنفيذ Samer Book.xlsm

السلام عليكم ورحمة الله استخدم هذا الكود بدلا من الكود المدرج بالملف Sub settle2() Dim LR As Long LR = Sheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row Range("K6:P6").Copy Sheets("Sheet1").Range("C" & LR + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

خيراً يا جماعة ما حدث للأستاذ المؤدب والمحترم محمد عصام "أبا جودي" ؟ شفاه الله وعافاه ولا بأس طهور بإذن الله خالص الدعوات والأمنيات الطيبة بالعودة سالماً معافاً وسائر مرضي المسلمين فاللهم آمين

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

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

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

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

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

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

السلام عليكم اسمحوا لي بالمشاركة معكم و الاطلاع على ملفي المتواضع Private Sub basic_BeforeUpdate(Cancel As Integer) Me.one = [basic] Me.tow = [basic] + [incr] * 1 Me.three = [basic] + [incr] * 2 Me.four = [basic] + [incr] * 3 Me.five = [basic] + [incr] * 4 Me.six = [basic] + [incr] * 5 Me.seven = [basic] + [incr] * 6 Me.eight = [basic] + [incr] * 7 Me.nine = [basic] + [incr] * 8 Me.ten = [basic] + [incr] * 9 End Sub Private Sub incr_AfterUpdate() Me.one = [basic] Me.tow = [basic] + [incr] * 1 Me.three = [basic] + [incr] * 2 Me.four = [basic] + [incr] * 3 Me.five = [basic] + [incr] * 4 Me.six = [basic] + [incr] * 5 Me.seven = [basic] + [incr] * 6 Me.eight = [basic] + [incr] * 7 Me.nine = [basic] + [incr] * 8 Me.ten = [basic] + [incr] * 9 End Sub يمكن تنفيذ المطلوب بطريقتين استعلام او عن طريق فورم واخترت اسهل الطريقتين وكل ما عليك هو اضافة الراتب ومقدار الزيادة او العلاوة ليتم حساب الزيادة السنوية حتى 10 سنوات ملحوظة : برجاء التعديل على الفورم للموظف الرابع 600.000 بدلا من 600000 ليتطابق النموذج مع الجدول الخاص بكم تحياتي ... incr.accdb

أهلا بك محمد.. لكون أكسس لا يدعم الاستنساخ أثناء التشغيل فلابد من الإعتماد على مكونات ActiveX التي يوفرها أكسس... أحد هذه المكونات هو المكون Microsoft.Form.Frame يوفر هذا المكون سطح بيني(طبقة) قابل للاستنساخ؛ بين النموذج والمكونات الأخرى التابعة ل Microsoft.Form هذا مثال بسيط لطريقة إدراج الصور أثناء التشغيل حسب المفهوم السابق Photo.zip

شكرا استاذى @jjafferr تم عمل استعلام الحاق On Error Resume Next Dim strSQL As String Dim intHow_Many As Integer strSQL = "[Worker]='" & Me.Worker & "'" intHow_Many = DCount("*", "Workermain", strSQL) If intHow_Many > 0 Then Else DoCmd.SetWarnings False DoCmd.RunSQL "insert into Workermain (Worker) values (Worker)" DoCmd.SetWarnings True Exit Sub End If

وعليكم السلام 🙂 لا يوجد نموذج فرعي في مرفقك!! على العموم ، هذا تصحيح للكود الموجود في نموذجك: Private Sub Worker_BeforeUpdate(Cancel As Integer) Dim strSQL As String Dim intHow_Many As Integer strSQL = "[Worker]='" & Me.Worker & "'" intHow_Many = DCount("*", "Workermain", strSQL) If intHow_Many > 0 Then MsgBox "لقد تم تسجيل هذا الموظف مسبقا" cancel=true me.Undo Exit Sub End If End Sub جعفر

وعليكم السلام ورحمة الله قمت بتعديل طفيف على كود توزيع الأرقام ولست أدري إن كان يفي بالغرض لأني لم أفهم جيدا طريقة ومراحل عمل الكود... بن علية حاجي توزيع الارقام (1).xlsm

وعليكم السلام 🙂 تفضل: Private Sub Command24_Click() ' مفتاح اضافة موظف اخر لنفس القرار Dim strSQL As String Dim intHow_Many As Integer strSQL = "[KararNom]='" & Me.KararNom & "'" strSQL = strSQL & " And [KararYear]='" & Me.KararYear & "'" strSQL = strSQL & " And [CompID]=" & Me.CompId intHow_Many = DCount("*", "TblKararat", strSQL) If intHow_Many > 0 Then MsgBox "لقد تم تسجيل هذا الموظف مسبقا" Exit Sub End If DoCmd.RunCommand acCmdSaveRecord Dim x As Integer If MsgBox("تم اضافة وحفظ بيانات الموظف للقرار بنجاح. هل تريد اضافة موظف لنفس القرار؟", vbYesNo, "تنبيه") = vbYes Then Dim N, Y, F N = Me.KararNom: Y = Me.KararYear: F = Me.KararFrom DoCmd.GoToRecord , , acNext Me.KararNom = N: Me.KararYear = Y: Me.KararFrom = F Me.CompId.SetFocus Else DoCmd.RunCommand acCmdRecordsGoToNext Me.KararNom.SetFocus End If End Sub جعفر

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

جزاك الله خيرا

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

نعم ممكن قراءة البيانات بالطريقة التي لديك ، ولكني اعطيتك الطريقة الصحيحة في قاعدة البيانات 🙂 وصدقني ، ستكون اسهل لك في المستقبل ، لإستعمالها لأغراض اخرى ، وخصوصا عن طريق الاستعلام !! جعفر

السلام عليكم ورحمة الله تم عمل المطلوب في الملف المرفق... بن علية حاجي الدوائر الحمراء للطالب الراسب.xlsm

السلام عليكم تفضل هذا الكود يقوم بإنشاء جدول به 3 حقول تستطيع التعديل عليه كما تشاء: Dim sq As String sq = "CREATE TABLE Cars1 (Name1 TEXT(30)PRIMARY KEY, Year TEXT(4), Price CURRENCY)" DoCmd.RunSQL sq

اهلا بك اخى الكريم بالمنتدى -تفضل لك ما طلبت 1المطلوب.xlsx

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

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

السلام عليكم ورحمة الله أخي سليم، الكود الذي أنجزته رائع جدا والكود الثاني أروع، ولم أكن أعلم أن صاحب الموضوع طلب عناوين الخلايا (الحقول) الفارغة... وقد قمت بالتعديل على الكود السابق بما يلي: Private Sub Worksheet_Deactivate() For I = 1 To 7 If Cells(I + 4, 4) = "" Then S = S & "$D$" & I + 4 & ", " Next If Application.CountA(Range("D5:D11")) < 7 Then Feuil1.Activate: _ MsgBox " : لا يمكنك الخروج من الشيت. هناك حقول فارغة في الخلايا التالية" & Chr(10) & Mid(S, 1, Len(S) - 2) End Sub بن علية حاجي Book1.xlsm

الأخ الكريم محبوب أعتذر عن التأخر في الرد عليك ، فقد كنت منشغلاً .. إليك الشرح عله يفيدك إن شاء الله Sub YasserKhalil() 'تعريف المتغيرات Dim WBK As Workbook Dim SH As Worksheet, WS As Worksheet, Cell As Range 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء خاصية رسائل التنبيه Application.DisplayAlerts = False 'سطر لفتح المصنف المسمى حسابات العملاء لجلب البيانات منه Set WBK = Workbooks.Open(ThisWorkbook.Path & "\حسابات العملاء.xlsx") 'حلقة تكرارية لكل أوراق العمل في المصنف الحالي الذي يحوي الكود For Each SH In ThisWorkbook.Sheets 'سطر لاستثناء ورقة العمل المسماة الفهرس من الحلقة التكرارية If SH.Name <> "الفهرس" Then 'مسح محتويات النطاقات المراد جلب البيانات إليها SH.Range("C6:F99,H6:I99").ClearContents 'حلقة تكرارية لكل أوراق العمل في المصنف المسمى حسابات العملاء For Each WS In WBK.Sheets 'سطر لاستثناء ورقة العمل المسماة الفهرس الرئيسي من الحلقة التكرارية If WS.Name <> "الفهرس الرئيسى" Then 'بدء التعامل مع كل ورقة عمل على حدا With WS 'إذا كانت أول خلية تحتوي على التواريخ فارغة يتم الانتقال لورقة العمل التالية If IsEmpty(.Range("A6")) Then GoTo 1 'سطر لتفادي حدوث خطأ أي استمرار عمل الكود في حالة حدوث خطأ On Error Resume Next 'حلقة تكرارية لنطاق التواريخ For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row) 'إذا كانت الخلية التي تحتوي على التاريخ ، الشهر بها يساوي رقم الشهر في ورقة العمل في المصنف الحالي 'وكذلك السنة الموجودة في التاريخ تساوي سنة 2015 يتم تنفيذ الأسطر التالية If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then 'يتم جلب التاريخ ووضعه في العمود الثامن في أوراق العمل في المصنف الحالي SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value 'يتم جلب اسم العميل ووضعه في العمود الثالث في أوراق العمل في المصنف الحالي SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value 'يتم جلب قيمة القسط ووضعها في العمود الخامس في أوراق العمل في المصنف الحالي SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2) 'يتم جلب قيمة الكوبري ووضعها في العمود السادس في أوراق العمل في المصنف الحالي SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3) 'يتم جلب رقم التليفون ووضعه في العمود التاسع في أوراق العمل في المصنف الحالي SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value 'انتهاء أسطر الشرط End If 'الانتقال للخلية التالية التي تحوي تاريخ Next Cell 'انتهاء التعامل مع ورقة العمل من المصنف المسمى حسابات العملاء استعداداً للتعامل مع ورقة عمل جديدة 1 End With End If 'الانتقال لورقة عمل جديدة في المنصف المسمى حسابات العملاء Next WS End If 'الانتقال لورقة عمل جديدة في المصنف الحالي Next SH 'إغلاق المصنف المسمى حسابات العملاء بدون حفظ التغييرات WBK.Close SaveChanges:=False 'إعادة تفعيل خاصية رسائل التنبيه Application.DisplayAlerts = True 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub تقبل تحياتي