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

وعليكم السلام تم زيادة الخلايا وبالفعل لدى القائمة المنسدلة الإستكمال التلقائى وهو بمجرد كتابة الحرف الأول وفتح سهم القائمة سترى الأسماء التى تبدأ بهذا الحرف ولا يمكن عمل أكثر من هذا فى موضوع القائمة المنسدلة بارك الله فيك تم التعديل هنا قائمه منسدله مطاطية تقبل البحث فيها بدون تكرار وبدون فراغات.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

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

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

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

السلام عليكم كل عام وانتم بخير عذرا اخي لم انتبه لردك الاخير الا اليوم على كل حال جرب الملف Transfer Function1.xlsm

جرب هذا الملف يمكنك نقل المعادلة الى الملف عندك ARABIC_TIME.xlsx

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

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

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

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

لاخذ العلم فقط كل عامود من اكسل 16 يحتوي على 1,048,576 صف وليس 148,000 فقط (اي 7 مرات اكثر مما تتوقع يا صديقي وسام) واذا اكتمل العامود يمكنك الانتقال الى عامود اخر من نفس الصفحة الذي يحتوي على نفس العدد من الصفوف (هناك 16,384 عامود) اي ما مجموعه 1,048,576 × 16,384= حوالي 17 مليار و 180 مليون خلية (سكان الارض ثلاث مرات) هذا الكلام في كل صفحة(Worksheet) من نفس المصنف (Workbook) فما بالك اذا كان المصنف يحتوي على 100 بل 1000 صفحة للتأكيد هذا الماكرو Sub test() Range("b1") = Range("a:a").Rows.Count & " Rows in each column" Range("b1").WrapText = False Range("b2") = Rows(1).Rows.Columns.Count & " columns in each row" Range("b2").WrapText = False End Sub

جرب هذا التعديل لعله يفي الغرض 123.xlsx

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

الكود صحيح عشان انه بالغه العربيه انسخه وبيطلع مضبوط Expr1: Nz(DSum("[rr]";"اطراف الفاتورة";"[aa]='" & [aa] & "'")) aa=باركود rr= الرصيد الاولي Database8.accdb

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

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

تابع الموضوع التالي :

تفضل بثلاث خيارات وليس خيارين أم القرى ميلادي هجري ::بالتوفيق:: Kaser906تحويل التاريخ11.rar

تم معالجة الامر كما تريد هناك زران واحد لجلب البيانات من الشيت 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

وعليكم السلام-تفضل يمكنك استخدام هذه المعادلة =IF(AND(C1="",D1=""),"",IF(C1=D1,"متزن","غير متزن")) دالة if بأربع شروط.xlsm

طالما لم تقم برفع ملف اكسيل مع شرح كل المطلوب بكل دقة فيمكنك الإستعانة بهذا الرابط https://www.officena.net/ib/topic/91873-مساعدة-في-عهدة-مخزون-تسليم-واستلام-وتقارير/?tab=comments#comment-575657

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

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

للعمل بشكل جيد يجب 1-ازالة الخلايا المدمجة (عدو الاكواد) 2-ترتيب الييانات كما في الملف المرفق (صفحة Source) الكود اللازم Option Explicit Sub give_data_by_Order() Rem =====>> Created By Salim Hasbaya On 30/6/2019 Dim i#, r#, Fix_ro, t# Dim search_rg As Range Dim rg_to_copy As Range Dim m#: m = 2 Dim col As New Collection Dim last_row# last_row = Source_sh.Cells(Rows.Count, 1).End(3).Row For i = 1 To last_row On Error Resume Next If Source_sh.Range("e" & i) <> "" Then col.Add Source_sh.Range("e" & i).Value, Source_sh.Range("e" & i).Value End If Next On Error GoTo 0 Target_sh.Range("A:E").ClearContents For i = 1 To col.Count Set search_rg = Source_sh.Range("E:E").Find(col(i), after:=Source_sh.Cells(Rows.Count, "E")) r = search_rg.Row: Fix_ro = r If Not search_rg Is Nothing Then '=================== Do Set rg_to_copy = _ Source_sh.Range("a" & r + 1, Source_sh.Range("a" & r + 2).End(4).Resize(, 4)) Target_sh.Cells(m, 5) = search_rg.Value & " (" & t + 1 & ")" t = t + 1 rg_to_copy.Copy _ Target_sh.Cells(m, 1) m = m + rg_to_copy.Rows.Count + 1 Set search_rg = Source_sh.Range("E:E").FindNext(search_rg) r = search_rg.Row If r = Fix_ro Then Exit Do Loop '======================= End If t = 0 Next End Sub الملف مرفق Copy_Data_Please.xlsm

تفضل تم وضع معادلة استاذنا الكبير سليم له منا كل المحبة والإحترام فى ملفك Book11office.xlsx

بعد اذن الأستاذ عصام ولإثراء الموضوع تفضل Test3و1.xlsx

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

أهلا بك اخ كريم فى المنتدى تفضل لك ما طلبت tarheel1.xlsm

وعليكم السلام تفضل zz.xlsm

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

تفضل هذا الرابط يعمل http://ge.tt/4ok7y3T2/v/0 انظر الى الصورة

ممتاز دالة رائعة جعله الله فى ميزان حسناتك

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

وعليكم السلام ولكن كان عليك رفع الملف نفسه تجنبا لإهدار الوقت ولكن تفضل هذه الدالة المعرفة لعمل اللازم-لابد من وضعها فى مديول جديد Function Reversestr(str As String) As String Reversestr = StrReverse(Trim(str)) End Function واذا كان مثلا هذا التاريخ موجود بالخلية B2 فعليك كتابة هذه المعادلة فى خلية أخرى =Reversestr(B2)

تفضل اخى الكريم عليك استكمال باقى الشهور كما بالشهر الأول والثانى وكذلك مصروفات السنة ككل على نفس المعادلات بارك الله فيك ايراد ومصروف.xlsx

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

وعليكم السلام تفضل لك ما طلبت فورم بحث .xlsm