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

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

تم التعديل على اماكرو كما تريد Option Explicit Sub del_last_4() Dim cel As Range For Each cel In Range("F5", Range("M4").End(4)) If IsNumeric(cel) And _ cel <= 4 And _ Range("N" & cel.Row) = "مكمل" Then cel = vbNullString Next End Sub

جرب هذا الماكرو Option Explicit Sub del_last_4() Dim cel As Range For Each cel In Range("F5", Range("M4").End(4)) If IsNumeric(cel) And _ cel <= 4 Then cel = vbNullString Next End Sub

تفضل يمكنك ذلك عن طريق هذا الكود Private Sub SpinButton1_spinUp() Range("NUMERO").Value = SpinButton1 TextBox1.Value = Format(Range("NUMERO").Value, "0") End Sub Private Sub SpinButton1_spinDown() Range("NUMERO").Value = SpinButton1 TextBox1.Value = Format(Range("NUMERO").Value, "0") End Sub زر زيادة ونقصان في فورم2.xlsm

أحسنت أستاذ سليم بارك الله فيك وزادك الله من فضله وكل عام وانتم بخير

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

السلام عليكم من سلسلة معلومة في اكسس استخراج الاجمالي بواسطة دالة Dsum واستخراج العدد الكلي بواسطة دالة Count أتمنى لكم الفائدة dsum.accdb

بالتوفيق اخي الشربيني123 الله يسعدك

تسلم اخي الشربيني 123 جرب هذا =DCount("[المرحلة]";"الطالب";"[المرحلة]=4 and [الصف]=" & [الصف] & " ")

عليك السلام ورحمة الله وبركاته جرب هذا 123.xlsx

ممكن تختصر الكود هكذا تمهيدي =DCount("[المرحلة]";"الطالب";"[المرحلة]=1") ابتدائي =DCount("[المرحلة]";"الطالب";"[المرحلة]=2") اعدادي =DCount("[المرحلة]";"الطالب";"[المرحلة]=3 ") ثانوي =DCount("[المرحلة]";"الطالب";"[المرحلة]=4") ونصيحه ابتعد عن التسميات باللغه العربيه من الجدول والحقول والنماذج وكل شي اللغه العربيه تعمل مشاكل كثير في الاكواد وغيرها حال ولو ترمز لها بحرف انجليزي وابتعد عن اللغه العربيه اتفضل دعوة طيبة بظهر الغيب بيان.accdb

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

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

تفضل يمكنك استخدام هذا الكود Private Sub CommandButton2_Click() Dim str As String Dim i As Long For i = 0 To ListBox1.ListCount - 1 If ListBox1.Selected(i) Then If str <> vbNullString Then str = str & ", " str = str & ListBox1.List(i) End If Next TextBox2.Text = TextBox2.Text & " " & str End Sub ليست بوكس.xlsm

الأمر في غاية البساطة عليك بعمل الخطوة التي تراها بالصورة

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

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

جرب المرفق تغيير كامل حقل يوزر في الجدول حسب الاسم المختار في النموذج aceess55.accdb

واضح أستاذ @kha9009lid لذلك اعتقد ان الامر سيكون مستحيل ومع ذلك شكرا لك لاهتمامك الكبير ولوقتك الثمين لكن هذا لايعني انك ستتخلص مني هناك المزيد والكثير من الأسئلة ان شاء الله

استاذ عبد اللطيف تمت اضافة الكود لكن الامر لم ينجح والمشكلة قائمة بانتظار ردكم وشكرا

اشكرك أستاذ وجيه على مرورك ولكما بمثل ما دعوتما

اشكرك اخي الشربيني الكود هو عد لي عدد المرحلة اللي في جدول الطالب بشرط المرحله= ١ وهكذا نعم تقد تعدل الكود كما تشاء

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

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

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

شكرا دائما ً مبدع أستاذ سليم حاصبيا .... هذا هو المطلوب جزاك الله خيراً

شكرا لك اخي العزيز, لكن فكرتي هي في حال عدم وجود اتصال بالانترنت عند المستخدم

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

اتفضل Expr1: Nz(DSum("[الرصيد الافتتاحي]";"اطراف الفاتورة";"[باركود]='" & [باركود] & "'")) هذا حسب كودك والاصح هو بدل الرصيد الافتتاحي يكون الرصيد الاولى هكذا Expr1: Nz(DSum("[الرصيد الاولي]";"اطراف الفاتورة";"[باركود]='" & [باركود] & "'"))

قم بتغير الأمر اغلاق قاعدة البيانات DoCmd.Quit بهذا الأمر DoCmd.Close وحتى كود الاستاذ خالد سيعمل معك بدون الاضافة التي وضعتها انا بالمشاركة السابقة ::بالتوفيق::

استاذ @kha9009lid استخدم في بداية الكود On Error Resume Next وهذه الكود بدل رسالة التنبيه أو معها If Me.Dirty Then Me.Dirty = False ويمكنك استخدامهما ايضا معا عند النقر على زر خروج بدون كود في حدث عند الخطأ

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

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

تم معالجة الامر كما تريد هناك زران واحد لجلب البيانات من الشيت Master واخر لارسالها الى الشيت Data (يمكنك اضافة اعمدة في الشيت Data قدر ما تريد ابتداء من العامود M الماكرو الاول لجلب البيانات من الشيت Master والثاني لارسالها الى الشيت Data Option Explicit Sub give_data() Rem ====>> Created By Salim hasbaya 9/8/2019 Dim x As Boolean x = IsError(Application.Match([b3], Sheets("MASTER").Range("B4:B10000"), 0)) If x Then MsgBox "This Recorde: " & [b3] & " Not Exists" & Chr(10) & _ "Please Check the value of the cell B3", , "Salim Tell Yuo" Range("Info_range") = vbNullString Exit Sub End If Dim FB4$: FB4 = _ "=INDEX(MASTER!$C$4:$C$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FB5$: FB5 = _ "=INDEX(MASTER!$N$4:$N$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FB6$: FB6 = _ "=INDEX(MASTER!$BV$4:$BV$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FB7$: FB7 = _ "=INDEX(MASTER!$BM$4:$BM$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FB8$: FB8 = _ "=INDEX(MASTER!$F$4:$F$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" '============================= Dim FD4$: FD4 = _ "=INDEX(MASTER!$E$4:$E$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FD5$: FD5 = _ "=INDEX(MASTER!$D$4:$D$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FD6$: FD6 = _ "=INDEX(MASTER!$Q$4:$Q$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FD7$: FD7 = _ "=INDEX(MASTER!$G$4:$G$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" Dim FD8$: FD8 = _ "=INDEX(MASTER!$BR$4:$BR$10000,MATCH(B3,MASTER!$B$4:$B$10000,0))" '======================== Range("b4") = Evaluate(FB4): Range("b5") = Evaluate(FB5) Range("b6") = Evaluate(FB6): Range("b7") = Evaluate(FB7) Range("b8") = Evaluate(FB8) Range("D3").FormulaArray = _ "=INDEX(Data!$E$3:$E$1000,MAX(IF(Data!$C$3:$C$10000=b3,ROW($A$3:$A$11)-2,"""")))" Range("D3").Value = Range("D3").Value: Range("D4") = Evaluate(FD4) Range("D5") = Evaluate(FD5): Range("D6") = Evaluate(FD6) Range("D7") = Evaluate(FD7): Range("D8") = Evaluate(FD8) End Sub '+++++++++++++++++++++++++++++++++++++++++++++++++++ Sub trasnfer_data() Rem ====>> Created By Salim hasbaya 9/8/2019 Macro N#2 Dim DE As Worksheet, D As Worksheet Dim My_ro%, cont%, Anser As Byte Set DE = Sheets("SALIM"): Set D = Sheets("Data") cont = Application.CountIf(D.Range("a:a"), DE.Range("b3")) If cont <> 0 Then Anser = MsgBox("this recorde is alreday exist" & Chr(10) & _ "do you want to add it??", vbYesNo) If Anser <> 6 Then Exit Sub End If My_ro = D.Cells(Rows.count, 1).End(3).Row With D .Cells(2, 1).Resize(My_ro, 64).Interior.ColorIndex = xlNone With .Range("A" & My_ro + 1) .Value = DE.[b3] .Offset(, 1) = DE.[B4]: .Offset(, 2) = DE.[B5] .Offset(, 3) = DE.[B6]: .Offset(, 4) = DE.[B7] '============================= .Offset(, 5) = DE.[B8]: .Offset(, 6) = DE.[D3] .Offset(, 7) = DE.[D4]: .Offset(, 8) = DE.[D5] .Offset(, 9) = DE.[D6]: .Offset(, 10) = DE.[D7] .Offset(, 11) = DE.[D8] '=========================== .Resize(, 12).Interior.ColorIndex = 6 End With End With ' My_data = DE.[k6] End Sub الملف مرفق من جديد My_Salary_Updated .xlsm

تم التعديل على المعادلة والملف السابق

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

تفضل لك ما طلبت-كما قلت لك سابقا لابد من ضبط تنسيق الرقم القومى مش عارف ليه الموضوع صعب كده معك يا استاذ على فقط كان عليك ضبط التنسيق مع تثبيت الجزء الموجود بالمعادلة الخاص بالصفحة الأخرى اى وضعه بين علامة الدولار كما تلاحظ المعادلة المفروض والصح تكون هكذا =IFERROR(VLOOKUP(A2,'رقم الموظف'!$A$1:$G$130,5,0),"") Pay-aht_moustafa-20190802-040908.xlsx Pay-mttks_magdi-20181011-082233-2019 - Copy.xls

كان عليك من البداية رفع الملف لكى تكون المساعدة أدق ولكن مثلا ضع هذا الكود في كوماند بوتن Enter في الفورم Private Sub CommandButton2_Click() UserForm1.Hide Application.Visible = True Sheets("Sheet8").Select End Sub

تم معالجة الامر وتعديل المعادلات للحصول على سرعة أفضل اذ ليس من المعقول ان تأخذ جدولا من b4 الى xfd4 ونزولاً على كل الصفوف اي أكثر 17 مليار خلية (عدد سكان الارض ضرب 3) لتبحث من خلاله على خلية واحدة الكود Sub trasnfer_data() Dim DE As Worksheet, D As Worksheet Dim My_ro% Set DE = Sheets("Data Enter"): Set D = Sheets("Data") My_ro = D.Cells(Rows.Count, 3).End(3).Row With D .Cells(2, 1).Resize(My_ro, 64).Interior.ColorIndex = xlNone .Range("C" & My_ro + 1) = DE.[k8] .Range("N" & My_ro + 1) = DE.[k10] .Range("BV" & My_ro + 1) = DE.[k12] .Range("BM" & My_ro + 1) = DE.[k14] 'ok '============================= .Range("F" & My_ro + 1) = DE.[I16] .Range("Br" & My_ro + 1) = DE.[O16] .Range("E" & My_ro + 1) = DE.[AD6] '=========================== .Range("R" & My_ro + 1) = DE.[Af8] .Range("D" & My_ro + 1) = DE.[AD10] .Range("Q" & My_ro + 1) = DE.[ad12] .Range("G" & My_ro + 1) = DE.[ad14] .Range("J" & My_ro + 1) = DE.[ad16] .Cells(My_ro + 1, 1).Resize(, 64).Interior.ColorIndex = 6 End With End Sub الملف My_Salary .xlsm

وعليكم السلام عليك برفع ملف وشرح المطلوب بالتفصيل

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

وعليكم السلام تفضل Test2.xlsx

بارك الله فيك وجزاك الله كل خير وجعله الله فى ميزان حسناتك الأفضل ان يكون الرابط مباشرة هكذا http://www.mediafire.com/file/3z2niqgki4p1yv5/كنترول+المرحلة+الابتدائية_2018_2019.rar اسم المستخدم: eika كلمة المرور : 5677

اهلا بك اخ كريم فى المنتدى -كلمة السر موجودة بالمشاركة الأولى الرقم السرى للدخول الى البرنامج هو 123

أحسنت استاذ ابراهيم جزاك الله كل خير -كود ممتاز

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

يمكن يكون نسخة الإكسيل لديك اعلى من النسخة المرسل اليها الملف بارك الله فيك

لو الخطأ مع معادلتى انا فلابد من الضغط على Ctrl+Shift+Enter وليس Enter فقط كباقى المعادلات لكى تعمل المعادلة بكل دقة لأنها معادلة مصفوفة وليست معادلة عادية بارك الله فيك

أحسنت استاذ شريف معادلة رائعة ولإثراء الموضوع هذا حل اخر بمعادلات المصفوفة دالة تحسب المبالغ بدلالة الشهر والسنة وذلك من التاريخ 1.xlsx