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

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

مشاركة مع استاذي العزيز ابا جودي aaa.rar

اتفضل يا دكتور محمد @حلبي علشان بس انت حبيبى عملت لك كود ضغنون ومحندق كده يتحط فى موديول عام وتستطيع استخدامه من نموذج بقه او من استعلام زى ما تحب فكما تعلمت من استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @ابوخليل تستطيع استخدامه فى كل زوايا التطبيق Public Function DelDataAllTbl() Dim T As TableDef DoCmd.SetWarnings False For Each T In CurrentDb.TableDefs If Not Left(T.Name, 4) = "MSys" Then DoCmd.RunSQL "DELETE * FROM [" & T.Name & "]" End If Next T DoCmd.SetWarnings True End Function تستدعيه بالطريقة دى . بس ما تنادى بصوت عالى وانت تستدعيه .... العالم بالمنتدى يحبون السكون فلا تحدث ضجيجا والا DelDataAllTbl()

طيب بص دالة CEILING اولا هى دالة من دوال الاكسل وليس الاكسس ولكن ممكن تحقيقها برمجيا لتناسب الاكسس من خلال الاكواد والمرفق يوضح ذلك الشــــــــــــرح الوصف تُرجع رقماً تم تقريبه للأعلى، بعيداً عن الصفر، إلى أقرب مضاعف للوسيطة significance. على سبيل المثال، إذا كنت تريد تجنب استخدام السنت في الأسعار وكان سعر المنتج 4,42 ر.س.، فاستخدم الصيغة ‎=CEILING(4,42,0,05)‎ لتقريب السعر للأعلى إلى أقرب مبلغ صحيح. بناء الجملة CEILING(number, significance)‎ يحتوي بناء جملة الدالة CEILING على الوسيطتين التاليتين: Number مطلوبة. وهي القيمة التي تريد تقريبها. Significance مطلوبة. وهي المضاعف الذي تريد التقريب إليه. ملاحظات إذا كانت قيمة أي الوسيطتين غير رقمية، فستُرجع الدالة CEILING قيمة الخطأ ‎#VALUE!‎. يتم تقريب القيمة للأعلى عند تعديلها بعيداً عن الصفر، وذلك بغض النظر عن علامة الوسيطة number. أما إذا كانت number عبارة عن مضاعف صحيح للوسيطة significance، فلن يحدث أي تقريب. إذا كانت قيمة الوسيطتين number وsignificance سالبتين، فيتم تقريب القيمة للأدنى، بعيداً عن الصفر. إذا كانت قيمة number سالبة وكانت قيمة significance موجبة، فيتم تقريب القيمة للأعلى باتجاه الصفر. مثال انسخ البيانات النموذج في الجدول التالي، والصقها في الخلية A1 في ورقة عمل Excel جديدة. لعرض نتائج الصيغ، حدد هذه الأخيرة، ثم اضغط على F2، ثم اضغط على Enter. عند الحاجة، يمكنك ضبط عرض العمود لرؤية البيانات كافة. الصيغة الوصف ‎=CEILING(2.5, 1)‎ تقريب 2,5 للأعلى إلى أقرب مضاعف لـ 1 3 ‎=CEILING(-2.5, -2)‎ تقريب ‎-2,5 للأعلى إلى أقرب مضاعف لـ ‎-2 ‎-4 ‎=CEILING(-2.5, 2)‎ تقريب ‎-2.5 للأعلى إلى أقرب مضاعف لـ ‎-2 ‎-2 ‎=CEILING(1.5, 0.1)‎ تقريب 1,5 إلى أقرب مضاعف من لـ 0,1 1,5 ‎=CEILING(0.234, 0.01)‎ تقريب 0,234 إلى أقرب مضاعف من لـ 0,01 0,24 امثلة Ceiling(2.5, 1) equals 3 Ceiling(2.5) equals 3 Ceiling(-2.5, -2) equals -4 Ceiling(-2.5, 2) equals -2 Ceiling(1.5, 0.1) equals 1.5 Ceiling(0.234, 0.01) equals 0.24 وهذا المرفق الذي يخص تحقيقها بالاكسس برمجيا لانها غير موجودة بالاكسس وهذا المرفق فيه طلب حضرتك تحديدا استاذ @عبد الله قدور Ceiling function (2).mdb

لم يكن هناك اخطاء ولكن تم استدعاء دوال API بطريقة تخص نظام 32 فقط لانه تقريبا انذاك الوقت لم يكون هناك نظام 64 تحياتى لك

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

العفو منكم استاذى الجليل انتم اغلى الغوالى واشهد الله تعالى اننى احبكم فى الله جميعا

احسن ناس وعلى الراس وبالعين

السلام عليكم ورحمة الله ضعى هذا الكود فى حدث الفورم Private Sub CommandButton1_Click() Dim ws As Worksheet, LR As Long Set ws = Sheets("æÑÞÉ1") LR = ws.Range("J" & Rows.Count).End(3).Row + 1 If Not IsEmpty(Me.TextBox1.Value) Then ws.Cells(LR, "J") = Me.TextBox1.Value Me.TextBox1.Value = "" End If End Sub

اجمعين يارب العالمين رحم الله والديك على هذا الدعاء وانا بخدمتك استاذي العزيز

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

اخى الفاضل التاريخ فى السجل الثانى هو 12/12/2019 الى 25/2/2020 عاوز استخرج ايام الاجازة فى 2020 فقط باليوم يعنى هنبدا من شهر يناير 31 يوم وتاريخ نهاية الاجازة 25/2 يبقى يناير كله و25 يوم من شهر فبراير يبقى المجموع 56 يوم فى السجل دة فقط

شهر يناير 31 يوم وشهر فبراير هناخد منه 25 يوم يبقى المجموع 56

عمود المبلغ يحتوي على اكثر من خلية اي واحدة تريدين على كل حال جربي هذا الملف اذا وجد البرتامج خلية فارغة (قبل احر حلية في اخر صف) يضع البيانات فيها مثلاُ : الخلية j4 فارغة و اخر ضف في J:J هو رقم 15 يقوم البرنامج بوضع الداتا في الخليتين J4 & I4 Om_hamza_User.xlsm

جرب هذا الملف بالنسبة للسحب صفحة Target بالنسبة لأعلى 3 ايداع أو 4 ايداع أو 5 ايداع (تختار ما تريد من الخلية H1 ) الصفحة Max_3 الكود Option Explicit Sub Get_Sahb() Dim S As Worksheet, T As Worksheet Dim Rg As Range, x% Dim Cret$: Cret = "سحب" Set S = Sheets("Source") Set T = Sheets("Target") T.Range("A2").CurrentRegion.Clear Set Rg = S.Range("A2").CurrentRegion S.AutoFilterMode = False Rg.AutoFilter 9, Cret Rg.SpecialCells(12).Copy T.Range("B2").PasteSpecial (8) T.Range("B2").PasteSpecial (12) S.AutoFilterMode = False x = T.Range("A2").CurrentRegion.Rows.Count If x > 1 Then T.Range("A2") = "#" T.Range("A3").Resize(x - 1) = _ Evaluate("row(1:" & x - 1 & ")") End If With T.Range("A2").CurrentRegion If .Rows.Count > 1 Then .Borders.LineStyle = 1 .InsertIndent 1 .Font.Bold = True .Font.Size = 14 .Interior.ColorIndex = 35 With .Rows(1) .HorizontalAlignment = xlCenter .Interior.ColorIndex = 6 End With End If End With End Sub Ali_244.xlsm

اه نسيت اقول لك ممكن تستخدم ماكرو

السلام عليكم ورحمة الله وبركاته اتفضل اخوي العزيز .. Copy of البيانات.xlsm

السلام عليكم ورحمة الله وبركاته حياكم الله وبياكم عندنا في الاكسل الدالة =CEILING(A1;5) تقوم بتقريب الرقم الى الاعلى الى اقرب خمسة يعني اذا كان الرقم 11 او 12 او 13 او 14 يصبح الرقم 15 وهكذا الى الاعلى بخمسة وان كان الرقم 10 تقوم بالتقريب الى اقرب عشرة في المثال السابق يصبح الناتج 20 هل هناك دالة في الاكسس تقوم بهذا العمل مثال اذا كان صافي راتب موظف 12316 فقد احتاج الى تقريبه الى 12320 او 12325 حسب الحاجة

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

الاخ @ابا جودى انت استاذ ومبدع وانا اتعلم منك وانا لست خبيرا ولا مبرمجا انا مازلت اتعلم منكم ومن الاخوة المبدعين في هذا المنتدى ارجو ان لا يكون كلامك سوء ظن بي وسؤالي هو لطلب العلم والمعرفة والاستزادة مما عندكم فأنا لا اعرف الكثير عن دوال الاكسس ولم استخدم معظمها اقدم اعتذاري ان فهمتني خطاً

وشكرا ابا جودي ، والحمدلله انتهى الموضوع 🙂 جعفر نعم ، انا تصرفت بمشاركتك 🙂

وعليكم السلام 🙂 اذا كانت عندك علاقة بين الجداول ، وتكون مختار الاختيار الثالث اللي عليه السهم : . فلما تحذف سجلات الجدول 1 ، سيتم حذف سجلات جميع الجداول التي لها علاقة بهذا الجدول 🙂 جعفر

ردي على حسب المعلومة التي ارفقتها 🙂 بدل ان تعمل حقل BOX لكل سجل ، قد يمكنك استعمال النموذج التالي: . وكود بعد التحديث بعد النقر على قائمة ListBox : Private Sub lst_ID_AfterUpdate() Me.ID.SetFocus DoCmd.FindRecord Me.lst_ID, , , , , acCurrent, True End Sub جعفر 1301.PPPP.accdb.zip

لم أفتح محرر الفجوال ولم أجرب ، الكتابة مباشرة: أقسم الرقم على 10 ثم قربها وبعدها اضرب الناتج في عشرة Round(myNum / 10, 0) * 10 كما يوجد دالة Roundup يمكنكم تجربتها ومعرفة الفرق بينها وبين الدالة Round إن شاء الله تطلع الدالة تبع ال VBA 🙂

معلومة قيمة استاذنا @ابا جودى تستحق الشكر لكن عندي سؤال استاذي العزيز اذا استخدمنا الصيغة التالية / =Int(-0.2*[txtTest])/-0.2 / آلا تعطي نفس النتيجة ؟ Ceiling function (2).mdb

يلي ماإلو أديم ماإلو جديد 😄 مشكور استاذنا @ابا جودى

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

PPPP (3).accdb

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

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

السلام عليكم ورحمة الله وبركاته اتفضل اخوي العزيز .. ان شاء الله يكون هو المطلوب Copy of النبطشية.xlsm

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

ابا جودى شكرا لك على الرد .... الحمد لله حليت الموضوع بطريقه تختلف عن الذي ارسلته لي . حيث طريقتك ممتازه اذا لم يكن لديك جدول مرقم . ولكن لا اتوقع بان طريقتك تصلح لعملي ... لان جدولي مرقم من 1-136 ... شكرا لك مره اخرى ...

تفضل وبما انك لم تقم برفع ملف للمطلوب فعليك بمشاهدة هذه الفيديوهات فبها طلبك -بارك الله فيك تجميع وتلخيص اكثر من ورقة في ورقة واحدة اكسل Excel Consolidate وكيفية دمج داتا اكثر من شيت اكسيل في شيت واحد

بفضل الله تم حل الموضوع ...

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

معادلة واحدة توضع في الخلية F2 و تسجب 6 أعمدة يميناَ ثم نزولاً صفين عند كتابة المعادلة تضغط (Ctrl+Shift+Enter) وليس Enter وحدها جرب هذا الملف =INDEX($A$2:$C$14,MATCH($E2&MID(F$1,1,3),$A$2:$A$14&$B$2:$B$14,0),3) Dawood.xlsx

end: Switch(IsNull([تاريخ انتهاء التقرير]);'A';[تاريخ انتهاء التقرير]<=Date();'B';[تاريخ انتهاء التقرير]>=Date();'C') اوكي استاذ تدلل

شكراااااااااااااااااااا جداااااااااااااااااااااا بارك الله فيك

الأمر بكل بساطة كان عليك عمله بنفسك وتزويد من تريد من النطاق بالمعادلة ... وعليك ان تعلم ما حدث معك من خطأ بسببك انت لأن هذه معادلة مصفوفة وليس معادلة عادية فيجب عليك بعد عمل المعادلة الضغط على (Ctrl+Shift+Enter) وليس Enter فقط كباقى المعادلات moooo2.xlsx

شكرا اخي نبراس 🙂 لو استعملت الاداة الخاصة بالكود ووضعت الكود داخل المربع المنبثق الخاص به ، حتى يظهر الكود بالطريقة الصحيحة 🙂 ، ويسهل قراءته : end: Switch(IsNull([تاريخ انتهاء التقرير]);"لم يسلم";[تاريخ انتهاء التقرير]<=Date();"منتهي";[تاريخ انتهاء التقرير]>=Date();"غير منتهي") جعفر

ما اروعك استاذ سليم كود يفى بالموضوع تمام سلمت يمينك وبارك الله فيك حفظك الله اشكرك سيدى الاستاذ سليم

بعد البحث بالنت تم التوصل الى الحل end: Switch(IsNull([تاريخ انتهاء التقرير]);"لم يسلم";[تاريخ انتهاء التقرير]<=Date();"منتهي";[تاريخ انتهاء التقرير]>=Date();"غير منتهي") الحمد لله

تم التعديل Option Explicit Sub FInd_Please() Dim S As Worksheet, T As Worksheet Dim LR%, x%, y%, n%, m% Dim F_rg As Range, Search_rg As Range Dim Find_wath Dim Ad1$, Ad2$ With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Set S = Sheets("Source") Set T = Sheets("Target") With T.Range("C8").CurrentRegion .ClearContents .Interior.ColorIndex = xlNone End With x = S.Range("A8").CurrentRegion.Rows.Count y = S.Range("A8").CurrentRegion.Columns.Count If T.Range("c2") = vbNullString Then GoTo Exit_Sub Select Case T.Range("C2") Case "مسلسل": n = 1 Case "اسم التلميذ": n = 2 Case "الرقم القومي": n = 3 Case "المحافظة": n = 4 Case "تاريخ الميلاد": n = 5 Case Else: GoTo Exit_Sub End Select Select Case T.Range("B2") Case Is <> "" Find_wath = T.Range("B2") Case Else Find_wath = "*" End Select If Find_wath = "*" Then T.Range("A9").Resize(x, y).Value = _ S.Range("A8").Resize(x, y).Value Else Set F_rg = S.Range("A7").CurrentRegion.Columns(n) Set Search_rg = F_rg.Find(Find_wath, LookIn:=xlValues, lookat:=1) If Search_rg Is Nothing Then MsgBox "Check Up the Cell B2" GoTo Exit_Sub End If Ad1 = Search_rg.Address: Ad2 = Ad1 m = 9 Do T.Range("A" & m).Resize(, y).Value = _ S.Range("A" & Search_rg.Row).Resize(, y).Value m = m + 1 Set Search_rg = F_rg.FindNext(Search_rg) Ad2 = Search_rg.Address If Ad1 = Ad2 Then Exit Do Loop T.Range("A9").Resize(m - 9, 12) _ .Interior.ColorIndex = 19 End If Exit_Sub: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub fuzy_data_new.xlsm

تم معالجة الأمر 1- لبس المرة الأولى التي أقول فيها: تسمية الشيتات باللغة الأجنبية و فصل الجدول عن باقي الخلايا بصفوف فارغة و عدم ادراج خلايا مدمجة داخل الجدول / ولا حياة لمن تنادي / (تم اضافة صفوف فارغة لهذا الأمر لآخر مرّة لن امد يد المساعدة بعد الآن بدون هذه الأشياء) 2- اذا كات الخلية B2 فارغة تحصل على كل البيانات Option Explicit Sub FInd_Please() Dim S As Worksheet, T As Worksheet Dim LR As Long, Nam As String Dim F_rg As Range, d% Dim Find_wath Dim Search_rg As Range Dim x%, y%, n% With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Set S = Sheets("Source") Set T = Sheets("Target") T.Range("C8").CurrentRegion.ClearContents x = S.Range("A8").CurrentRegion.Rows.Count y = S.Range("A8").CurrentRegion.Columns.Count If T.Range("c2") = vbNullString Then GoTo Exit_Sub Select Case T.Range("C2") Case "مسلسل": n = 1 Case "اسم التلميذ": n = 2 Case "الرقم القومي": n = 3 Case "المحافظة": n = 4 Case "تاريخ الميلاد": n = 5 Case Else: GoTo Exit_Sub End Select Select Case T.Range("B2") Case Is <> "" Find_wath = T.Range("B2") Case Else Find_wath = "*" End Select If Find_wath = "*" Then T.Range("A9").Resize(x, y).Value = _ S.Range("A8").Resize(x, y).Value Else Set F_rg = S.Range("A7").CurrentRegion.Columns(n) Set Search_rg = F_rg.Find(Find_wath, lookat:=1) If Search_rg Is Nothing Then MsgBox "Check Up the Cell B2" GoTo Exit_Sub End If T.Range("A9").Resize(, y).Value = _ S.Range("A" & Search_rg.Row).Resize(, y).Value End If Exit_Sub: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub fuzy_data.xlsm

تم التعديل على الكود بصيد الخطأ فى حالة تم الحاق البيانات من قبل كما تم التعديل على الجدول TableBarcodeBrExh حتى لا يقبل التكرار On Error GoTo Err_CmdMove_Click If IsNull([FBarcod]) Then MsgBox (ChrW("1581") & ChrW("1602") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1575") & ChrW("1585") & ChrW("1603") & ChrW("1608") & ChrW("1583") & ChrW("32") & ChrW("1605") & ChrW("1591") & ChrW("1604") & ChrW("1608") & ChrW("1576")) Me.FBarcod.SetFocus Else Dim db As DAO.Database Dim rs As DAO.Recordset Dim i As Integer Dim intQty As Integer Set db = CurrentDb Set rs = db.OpenRecordset("TableBarcodeBrExh") intQty = [Nom] For i = i To intQty rs.AddNew rs("ID") = Me![id] rs("itmCode") = Me![CodeItem] rs("NameItem") = Me![ItemNam] rs("NoBarcode") = Me![FBarcod] + i + 1 rs("Unets") = Me![Unet] rs("NoMat") = 1 rs("Praice") = Me![PrIce] rs("Qty") = 1 rs("Totals") = 1 rs.Update Next i rs.Close Me![Form_BarcodeBrExhSubform].Requery MsgBox "done" End If Exit_CmdMove_Click: Exit Sub Err_CmdMove_Click: If Err.Number = 3022 Then MsgBox (ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1581") & ChrW("1575") & ChrW("1602") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1605") & ChrW("1606") & ChrW("32") & ChrW("1602") & ChrW("1576") & ChrW("1604")) Else MsgBox Err.Description Resume Exit_CmdMove_Click End If الحمد لله بس خلاص رقم الباركود - Update v1 .accdb

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

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

اتعلم موشن جرافيك بالبوربوينت رسم وتحريك لمشهد كسر البيضه وخروج الكتكوت البوربوينت أكثر من مجرد إنشاء شرائح العرض التقديمي يوجد أدوات وطرق جديدة لاستخدام PowerPoint لهواة رسم وتحريك الروسومات https://youtu.be/zgUGrobp5xc

السلام عليكم أخي الكريم في المرفقات ملف يقوم بما تطلب وللأمانة فإن هذا الملف قمت بتحميله من أحد المنتديات , لا أذكر أيها ولا أذكر اسم صاحبها , جزاه الله خيراً وجعله في ميزان حسناته. فكرة البرنامج : قم بإضافة النموذج والجدول إلى قاعدة بياناتك التي تريد مراقبتها , وعند فتح قاعدة البيانات يقوم بتشغيل هذا النموذج ثم يغلقه فيقوم بإضافة بيانات المستخدم إلى جدول دون أن يشعر. والسلام عليكم ________________.rar