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

السلام عليكم 🙂 استاذ فايز ، اذا تذكر الاكواد الطويلة اللي كتبتها لك عند استيراد اكثر من صفحة من ملفات الاكسس ، او اكثر من ملف اكسس ، هذه الاكواد كانت لتنظيف البيانات من السجلات الفارغة (مثل السجل الاول الذي به الاسم ، ثم اخذ الاسم وبقية البيانات من السجل الاول واتسجيله لبقية السجلات التابعة للطالب 🙂 اما وقد رجعنا الى كود استيراد البيانات من الاكسل كما هي ، فوجب علينا ، ومثل ما قال اخي اباجودي ، فعلينا بتعبئة هذه البيانات ، لذا عملت استعلام تحديث ، ليقوم بتعبئة هذه البيانات ، بعد استيرادها مباشرة من ملف الاكسل ، هكذا : Private Sub command1_Click() Dim ImportFileName As String ImportFileName = CurrentProject.Path & "\CS_FinalMarksReport" & ".xlsx" CurrentDb.Execute ("Delete * From Tabl_1") If MsgBox("هل تريد استيراد البيانات من جديد ؟", vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then DoCmd.TransferSpreadsheet acImport, 8, "Tabl_1", ImportFileName, True DoCmd.SetWarnings False '| DoCmd.OpenQuery "qry_Filled" '| <------- DoCmd.SetWarnings True '| MsgBox "تم استيراد البيانات بنجاح" Else MsgBox "تم إلغاء عملية الاستيراد " End If End Sub . وهذا هو الاستعلام : . وهذه جملة SQL الاستعلام: UPDATE Tabl_1 SET Tabl_1.A1 = f_A1(Nz([A1],"|")), Tabl_1.A2 = f_A2(Nz([A2],"|")), Tabl_1.A3 = f_A3(Nz([A3],"|")), Tabl_1.A4 = f_A4(Nz([A4],"|")), Tabl_1.A5 = f_A5(Nz([A5],"|")); . وهذه هي الوحدات النمطية التي تناديها للعمل: Option Compare Database Option Explicit Public p_A1 As String Public p_A2 As String Public p_A3 As String Public p_A4 As String Public p_A5 As String ' Public Function f_A1(A1 As String) As String If A1 = "|" Then f_A1 = p_A1 Else p_A1 = A1 f_A1 = p_A1 End If End Function Public Function f_A2(A2 As String) As String If A2 = "|" Then f_A2 = p_A2 Else p_A2 = A2 f_A2 = p_A2 End If End Function Public Function f_A3(A3 As String) As String If A3 = "|" Then f_A3 = p_A3 Else p_A3 = A3 f_A3 = p_A3 End If End Function Public Function f_A4(A4 As String) As String If A4 = "|" Then f_A4 = p_A4 Else p_A4 = A4 f_A4 = p_A4 End If End Function Public Function f_A5(A5 As String) As String If A5 = "|" Then f_A5 = p_A5 Else p_A5 = A5 f_A5 = p_A5 End If End Function . ومن هنا ، فيمكنك عمل استعلام عادي لأي شيء يخص البيانات ، مثل طلبك في هذا الموضوع 🙂 ونعم تستطيع استعمال الاستعلام لتعبئة بيانات جدولك الحالي ، وبدون استيراده مرة اخرى 🙂 جعفر 1312.Database2.accdb.zip

جرب هذا الكود Option Explicit Sub Get_Data() Dim A As Worksheet Dim sh As Worksheet Dim ar(), itm Dim lr%, m%, t%, Mmax% Dim R_copy As Range Set A = Sheets("all") m = -1: t = 4 If A.Range("A3").CurrentRegion.Rows.Count > 1 Then With A.Range("A3").CurrentRegion.Offset(1). _ Resize(A.Range("A3").CurrentRegion.Rows.Count - 1) .Interior.ColorIndex = xlNone .ClearContents End With End If For Each sh In Sheets If sh.Name <> A.Name Then m = m + 1 ReDim Preserve ar(m) ar(m) = sh.Name End If Next If m > 0 Then For Each itm In ar Set sh = Sheets(itm) Set R_copy = sh.Range("A3").CurrentRegion Mmax = R_copy.Rows.Count If Mmax > 1 Then With A.Cells(t, 1) .Resize(, 8).Interior.ColorIndex = 6 .Resize(Mmax - 1, 8).Value = _ sh.Range("A3").CurrentRegion.Offset(1).Resize(Mmax - 1).Value t = t + Mmax - 1 End With End If 'Mmax Next End If 'm End Sub الملف مرفق Moustafa.xlsm

طبعا في اسماء يجب التعامل معها بطريقة خاصة ، وتقدر تدخلها في الوحدة النمطية ، ولكن اليك ما تعمله الوحدة النمطية: Function SP(M, N) On Error GoTo err_SP Dim A As Integer 'testing If M = "äæÑÇáÏíä Úáã ÇáÏíä ÚÈÏ ÇáÍÝíÙ" Then A = 1 End If 'SP = Seperate Mother's name to its names 'M = Mothers name 'N = Which part of the name we are looking for Dim x() As String 'check if ÚÈÏ has a space after it, if not, add the space If InStr(M, "ÚÈÏ") > 0 Then M = Replace(M, "ÚÈÏ", "ÚÈÏ ") End If M = Replace(M, " ", " ") M = Replace(M, " ", " ") M = RTrim(M) M = LTrim(M) 'insert | to distinguish the combined names M = Replace(M, "ÚÈÏ ", "ÚÈÏ|") x = Split(M, " ") '1st name If N = 1 Then SP = x(0) '2nd name ElseIf N = 2 Then SP = x(1) '3rd name ElseIf N = 3 Then SP = x(2) '4th name ElseIf N = 4 Then SP = x(3) End If 'Remove the extra | SP = Trim(Replace(SP, "ÚÈÏ|", "ÚÈÏ ")) Exit Function err_SP: If Err.Number = 94 Then 'mother null SP = "" ElseIf Err.Number = 9 Then SP = "" Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function جعفر 1313.Test Four Name.mdb.zip

وين المرفق؟

انا كنت عامل كود بسيط لتفكيك الاسم ، يحسب حساب كلمة "عبد" ، فياريت ترفق لنا مرفق فيه بعض الاسماء علشان نجرب عليها 🙂 وطبعا ، ادخال الاسماء الاربعة مفككة هي الطريقة الصحيحة 🙂 جعفر

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

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

السلام عليكم ورحمة الله وبركاته ممكن تجرب اخوي الملف .. هل هذا هو المطلوب ولكن لكي يكون العمل اسهل تعمل عامود واحد .. على شكل تقويم .. وبعدها تحفظ البيانات .. عملت لك تقويم بشكل اسبوعي ... لكي تتضح لك الرؤية .. 1608643640739_UP.xlsb Taqwem.xlsm

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

😬 وانت عرفت ازاي ، يخرابي ، سر وانكشف 😬

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

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

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

الشرح - تم عمل موديول للاعلان عن متغير عام اسم المتغير العام cJob - فى نموذج LOGIN بعد اتمام المصادقة بالتأكد من اسم وكلمة مرور المستخدم نسند الوظيفة الى المتغير العام cJob = JOB - فى النموذج INSPCDATA استخدام كود الاستاذ جعفر فى حدث الحالى للنموذج بعد ان قمنا بتعريف البرنامج على الوظائف من خلال المتغير العام cJob كالاتى Select Case cJob Case Is = "MANGER" Me.AllowEdits = True Case Else If Len(Me.FDATE & "") = 0 Then Me.AllowEdits = True Else Me.AllowEdits = False End If End Select

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

السلام عليكم ورحمة الله وبركاته اضافة .. معادلة بغض النظر عن عدد الاوراق .. ومكان الاعمده المطلوب الحساب منها .. المهم هو اسماء الاعمدة .. sumsalarymultisheets.xlsm

نم التعديل على الكود لتظهر أسماء الشيتات حيث الاسم موجود Ihab_ALL_new.xlsm

يبدو اني طالب متأخر واعتذر منك استاذي الفاضل ماشاء الله تبارك الله ....كالعادة افكار مليئة بالفوائد .... جزاك الله خيرا

جرب هذا التعديل If len(me.Filddate & "")=0 then Me.Allowedits = true else Me.Allowedits = false endif جعفر

وهاي مشاركتي 🙂 . جعفر Exams.zip

اتفضل Exams (3).accdb

طريقة تانى لان انا عن نفسي افضلها لان Cancel = -1 او Cancel = True احيانا كانت تعطى خطأ Private Sub Report_NoData(Cancel As Integer) On Error GoTo ErrorHandler MsgBox "There is no data in the report. " & "The report will now close." DoCmd.Close acReport, Me.Name, acSaveNo ExitProcedure: Exit Sub ErrorHandler: 'MsgBox "Error " & Err.Number & " " & Err.Description DoCmd.CancelEvent Resume ExitProcedure End Sub

السلام عليكم.. في البداية شكرا لكل من قام بالرد على موضوعي السابق في وقتنا الحاضر ارى ان اغلب البرامج في السوق هي من هذا النوع وللأسف لم اجد التفاعل الكبير معها، خصوصا في موضوعي في الأعلى عموما، قمت ببرمجة برنامج صغير لإدارة المخزن، وانتضر منكم التجربة للوقوع على الأخطاء ومحاولة تصحيحها علماً، ان النسخة مؤقتة وسوف تُغلق بعد تصحيح الأخطاء. باسورد فتح البرنامج = 313 تحياتي للجميع. store_manager.rar

لا يوجد اي حركة بدون اكواد واقصد بفكرتي تبسيط الفكرة الى الحد الأدنى انظر المرفق عملته على اعتبار حقل الاسم في النموذج معيارا في الاستعلام Test Full Name2.mdb

شكرا يا استاذ سليم بارك الله فيك وجزاك الله خيرا

طيب استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr ممكن حضرتك تجرب هبة الله نور الدين عصام الدين محمد وفى فى الاسماء كذلك جاه النبى - جاه الرسول اى خدمه يبقى كده المرفق بـ خمسة جنيه بس علشان خاطرك والناس الحلوة اللى تعبت معانا

يالله ع ليلة الكريسماس واللى يطيرون بالمرففات 🤣

تفضل يا أستاذي هنا جدول SomNamesTbl به بيانات وهمية متشابهة مع الحقيقية وجزاكم الله عنا خيرا والله ما أسعد بالحل قدر سعادتي بتواصلي مع اساتذتي وأحبتي بالمنتدي @ابا جودى @ابوخليل @jjafferr أشكركم جميعا وجعله الله بموازين حسناتكم

جرب هذا الملف تم ادراج معلومات عشوائية (يمكن استبدالها بما تريد) تم حماية المعادلات لعدم العبث بها عن طريق الخطأ لا تقم بالترقيم لانه يدرج اوتوماتيكياًعند اكتمال الصف (4 عناصر) من B الى D (حتى 500 صف) Happy.xlsx

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

🥰 انهو ارواح ياللى يحضرها الاستاذ @jjafferr بالبخور تبعه انت ياللى تختار الوقت اللى اشارك فيه وتنشل طيب جرب انت المرفق تبعى... منتظر ردك بس لا تكتب وتشارك بنفس الوقت تبعى

هذه مرفق للتجارب Test Four Name.rar هو احنا بنكتب الرد ليه مع بعض في وقت واحد كدا ( هو دا اللي اسمه تلاقي الأرواح ولا اليه ) 😀🤔

سأبحث الأمر باذن الله تعالى

شكرا لك أخي

انا اعمل لك البرنامج في الاكسس ، وتقريبا خلص ، ولكني واصل في التقرير : Positive ، negative ، All ;كيف طريقته ؟

الحقول لم تكن Null وانما كانت فارغة !! استعمل هذا الاستعلام : . UPDATE Tabl_1 SET Tabl_1.A1 = f_A1(IIf(Len([A1] & "")=0,"|",[A1])), Tabl_1.A2 = f_A2(IIf(Len([A2] & "")=0,"|",[A2])), Tabl_1.A3 = f_A3(IIf(Len([A3] & "")=0,"|",[A3])), Tabl_1.A4 = f_A4(IIf(Len([A4] & "")=0,"|",[A4])), Tabl_1.A5 = f_A5(IIf(Len([A5] & "")=0,"|",[A5])); . جعفر 1312.Database2.accdb.zip

كله تمام يا بشمهندس 🙂 جعفر

حمدا لله على السلامة .. من طول الغيبات جاء بالغنايم

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

السلام عليكم مشاركة ضعيفه منى مع اخوانى واساتذتى @jjafferr و @ابا جودى جزاهم الله خيرا 💐💐💐 انشات استعلام للحصول على اول سجل فارغ ثم فالنموذج قمت بوضع كود للتحديث Private Sub txtUpdate_Click() Dim db As DAO.Database Set db = CurrentDb Dim rs As DAO.Recordset Set rs = db.OpenRecordset("Tabl_1") Dim i As Integer For i = 0 To rs.RecordCount - 1 If IsNull(rs.Fields("A3")) Then rs.Edit rs.Fields("A1").Value = DLookup("A1", "Tabl_1", "[ÇáãÚÑÝ]=" & DLookup("FirstNum", "qry3") - 1) rs.Fields("A2").Value = DLookup("A2", "Tabl_1", "[ÇáãÚÑÝ]=" & DLookup("FirstNum", "qry3") - 1) rs.Fields("A3").Value = DLookup("A3", "Tabl_1", "[ÇáãÚÑÝ]=" & DLookup("FirstNum", "qry3") - 1) rs.Update Else End If rs.MoveNext Next i rs.Close Set rs = Nothing End Sub ومرفق المثال الجدول بدون تحديث اضغط زر التحديث فالنموذج تقبلوا تحياتى ومرورى وفقكم الله Database2.accdb

شوف يا أمير 🙂 الليلة كريسمس ، فالجماعة اللي يطيروا ، واللي اناديهم بالبخور ، ويجون يساعدوني ، مشغولين عني الليلة ، عماني واعرف شغلي 😁 فإذا اردت ان اساعدك ، فالمساعدة لازم تيجي منك مباشرة 😁 ارفق الكود اللي عندك فيه مشكلة ، او البرنامج ، لأني عملت التعديل على البرنامج اللي انت ارفقته 🙂 جعفر

الملف لم يفتح على جهازي اوفيس 2010

لاحظ هذه الصورة 1- في المريع الأحمر تضع اصفاراً حسب عدد الأعمدة المطلوبة ( في الصورة 4 أعمدة) 2- في المربع الأزرق تضع ارقام هذه الأعمدة (E=5 / F=6 / H=8 ) وهكذا

السلام عليكم المعادلة المكتوبة في الملف صحيحة (يمكن اختصارها) ولا خلل فيها... بالنسبة للحساب بالآلة الحاسبة لا يمكن أن نعرف كيف قمت بذلك (وأعتقد أن الخظأ في طريقة الحساب)... أما النتيجة فلا يمكن أن تكون سالبة مهما كانت القيم التي اخترتها لأن كلا من الجذر التربيعي (بشرط أن تكون قيمة S أكبر تماما من الصفر) وقيمة العدد النيبيري (e) موجبان دوما.... راجع حساباتك بالآلة الحاسبة مع مراعاة أولية العمليات...

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

الكود في حدث عند عدم وجو بيانات MsgBox "لا توجد بيانات لهذا التقرير. إلغاء التقرير...", vbMsgBoxRight, "لاتوجد بيانات" Cancel = -1 اضف حقل بالتقرير وسميه Cancel واجعل مصدره=1 تحياتي

في هذا الملف 1- الصفحة Result حيث تظهر النتيجة 3 صفوف تحنوي بيانات مهمه ليغمل عليها الكود الصفوف (5/4/3 مخفية) عدم المس بها كي لا يتعطل عمل الماكرو الصف رقم 5 يجب ان يكون فارغاُ نهائياً لقصل رأس الجدول عن البيانات 2-تكرار البيانات غير مسموح (الماكرو يحذف المكرر اذا كانت جميع بيانات الصف الواجد مكررة) بمعنى اخر اذا كبست الزر اكثر من مرة دون تعديل البيانات لا يعمل الماكرو أكثر من مرة واحدة الماكرو 3 -الزر Clear يمسح البيانات من source التي لا تحتوي على معادلات Option Explicit Sub Get_data() Dim S As Worksheet Dim R As Worksheet Dim i%, m%, Mx% Dim ArS(1 To 20) Dim ArR(1 To 20) Set S = Sheets("Source") Set R = Sheets("Result") m = R.Cells(Rows.Count, 2).End(3).Row + 1 If m < 6 Then m = 6 For i = 2 To 21 ArS(i - 1) = R.Cells(3, i) ArR(i - 1) = R.Cells(4, i) Next For i = 1 To 20 R.Cells(m, ArR(i)).Value = _ S.Range(ArS(i)).Value Next R.Cells(6, 2).Resize(m - 5, 20). _ RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, _ 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20), Header:=xlNo Mx = R.Range("B6").CurrentRegion.Rows.Count If R.Cells(6, 2) <> vbNullString Then With R.Cells(6, 1).Resize(Mx) .Value = Evaluate("Row(1:" & Mx & ")") With .Resize(, 21) .Borders.LineStyle = 1 .Font.Bold = True End With End With End If End Sub الملف مرفق laminedch.xlsm

السلام عليكم ورحمة الله يكفي إدراج هذا الجدول على شكل صورة في تذييل الصفحة... راجع الملف المرفق تجد فيه ما تريد... بن علية حاجيTest_1.xlsx

يبدو ان الامور تحسنت هذا هو التعديل studEhsa.rar

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