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

السلام عليكم 🙂 استاذ فايز ، اذا تذكر الاكواد الطويلة اللي كتبتها لك عند استيراد اكثر من صفحة من ملفات الاكسس ، او اكثر من ملف اكسس ، هذه الاكواد كانت لتنظيف البيانات من السجلات الفارغة (مثل السجل الاول الذي به الاسم ، ثم اخذ الاسم وبقية البيانات من السجل الاول واتسجيله لبقية السجلات التابعة للطالب 🙂 اما وقد رجعنا الى كود استيراد البيانات من الاكسل كما هي ، فوجب علينا ، ومثل ما قال اخي اباجودي ، فعلينا بتعبئة هذه البيانات ، لذا عملت استعلام تحديث ، ليقوم بتعبئة هذه البيانات ، بعد استيرادها مباشرة من ملف الاكسل ، هكذا : 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

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

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

طيب استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @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

لانى استخدم البخور العمانى ايضا 😏

هذا هو المرفق الخاص بأخى الاستاذ @بحار الاكسس حيث ان سيادته يواجه مشكلة فى رفع المرفقات بعد اذن الاستاذ @بحار الاكسس قمت بعمل استعلام جديد لجمع كل الابناء لكل الموظفين لان المطلوب Root-20.accdb

واستاذى الجليل و معلمى القدير و والدى الحبيب الاستاذ @jjafferr قدم الحل بالتمام جزاه الله كل الخيـــــــــر المشكلة عندك انت انت ياللى كان مفروض عليك تعرف البرنامج ع الموظفين والمدراء MMM.accdb

اشرح برنامجك الحالي الذي تقوم به بالتفصيل كيف ؟ اعتبر موظفا جديدا تم تعيينه عندك .. وكلفت بأن تكتب له شرحا كاملا لآلية العمل وهكذا يمكن للاخوة هنا ان يقوموا بتوجيهك كيف تبدأ تصميم برنامجك

هذا كان طلبك : جعفر

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

أهلا بكم.. قبل أن أبدأ في تناول موضوع التخلي عن الأعمدة الفارغة برمجياً؛ أود أن أتحدث عن مقطعين أساسيين في جملة الاستعلام... __ المقطع الأول: مسمى ورقة البيانات والمحددات التابعة لها [SCHEDULE$B17:END] فهذا المقطع يبين مسمى ورقة البيانات باللون الأرجواني في الشق الأيسر، واللون الأحمر في الشق الأيمن هو لمحددات موضع البيانات.. فالجزء الأيسر يشير إلى العمود (B) والسطر (17) في ورقة البانات، والجزء الأيمن (END) فيشير إلى أدنى مستوى من الخلايا التي بها بيانات.. وهذا يعني أن أعلى مستوي تبدء منه البيانات هو السطر (17)، وهذا السطر هو أول سطر للبيانات وليس قبله أي بيانات منتظمة تصلح أن تكون عناوين للعمدة، ولهذا نحتاج في المقطع الثاني أن نخبر أكسس كي يقوم بتجاهل سطر العناوين هذا ويضع عناوين من قبله! __ المقطع الثاني: يتضمن هذا المقطع بيانات متتعددة، وما همنا منها الآن هما جزآن [EXCEL 12.0;HDR=NO]؛ اللون الأرجواني يدل على مصدر البيانات ورقم الإصدار، وأما اللون الأحمر فهو يأمر أكسس بالتخلي عن أخذ السطر الأول كعناوين للأعمدة.. الوضع الافتراضي أن أكسس يسمى السطر الأول عناوين للأعمدة إذا كان مصدر البيانات هو أكسل.. ولهذا احتجنا إلى تقييدة.. __ أما مايتعلق بالتخلي عن الأعمدة الفارغة فنحن بحاجة إلى هذا الإجراء من أجل تهيئة البيانات لإنشاء جدول الحصص ولا نريد أن تكون الأعمدة الخالية موجدة ضمن الجدول عند الإنشاء.. من النموذج اضغط زر الأمر (QUERY COMMAND) ثم اضغط (MAKE SCHEDULE TABLE).. من النموذج اضغط زر الأمر (QUERY STATMENT) سوف تجد جملة إنشاء جدول الحصص ظاهرة أمامك.. اضغط زر الأمر (RUN QUERY).. وسوف يتم إنشاء الجدول خاليا من الأعمدة الفارغة.. __ يتبقى علينا ملئ حقل الرقم الأكاديمي بالبيانات المفقودة حتي يتم ربط هذا الجدول بجدول الطلاب بطريقة صحيحة.. Noor Data Processing.zip

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

وعليكم السلام-تم تغيير المعادلة بمعادلة أخرى أخفف منها وليست مصفوفة -تفضل =IFERROR(INDEX($A$2:$A$14,AGGREGATE(15,6,ROW($A$1:$A$14)/(MATCH($A$2:$A$14&$B$2:$B$14,$A$2:$A$14&$B$2:$B$14,0)=ROW($A$1:$A$14)),ROWS($2:2))),"") ترتيب التاريخ1.xlsx

جرب هذا الملف 1- يمكن ان تختار اسم واحد أو كل الاسماء 2- الجمع يتم على الأعمدة E و F و I و J من كل صفحة (تم عمل حساب تكرار الاسم في الصفحة الواحدة) 3- يالنسبة للاسم الواحد Sub Data_Sum_1() Dim Res As Worksheet Dim Sh As Worksheet Dim ro1%, ro2%, K% Dim F_rg As Range Dim Ar Set Res = Sheets("Result") Ar = Array(0, 0, 0, 0) If Res.Range("A1").CurrentRegion.Rows.Count > 2 Then Res.Range("A1").CurrentRegion.Offset(2). _ Resize(Res.Range("A1").CurrentRegion.Rows.Count - 2).Clear End If If Res.Cells(2, "H") = vbNullString Then Exit Sub For Each Sh In Sheets If Sh.Name <> "Result" Then Sh.Range("A3:J1000"). _ Interior.ColorIndex = xlNone Set F_rg = Sh.Range("B:B"). _ Find(Res.Cells(2, "H"), lookat:=1) If Not F_rg Is Nothing Then ro1 = F_rg.Row: ro2 = ro1 Do Sh.Cells(ro2, 1).Resize(, 10). _ Interior.ColorIndex = 35 Ar(0) = Ar(0) + Val(Sh.Cells(ro2, 5)) Ar(1) = Ar(1) + Val(Sh.Cells(ro2, 6)) Ar(2) = Ar(2) + Val(Sh.Cells(ro2, 9)) Ar(3) = Ar(3) + Val(Sh.Cells(ro2, 10)) Set F_rg = Sh.Range("B:B").FindNext(F_rg) ro2 = F_rg.Row If ro1 = ro2 Then Exit Do Loop End If End If Next Sh With Res.Cells(3, 1) .Value = 1 .Offset(, 1) = Res.Cells(2, "H") .Offset(, 2).Resize(, UBound(Ar) + 1) = Ar With .Resize(, UBound(Ar) + 3) .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .InsertIndent 1 .Interior.ColorIndex = 35 End With End With End Sub بالنسبة لكل الاسماء Sub Data_Sum_ALL() Dim Res As Worksheet Dim Sh As Worksheet Dim ro1%, ro2%, K% Dim F_rg As Range Dim Ar Dim OBJ As Object, ky Dim m%, t% Set OBJ = CreateObject("Scripting.Dictionary") Set Res = Sheets("Result") If Res.Range("A1").CurrentRegion.Rows.Count > 2 Then Res.Range("A1").CurrentRegion.Offset(2). _ Resize(Res.Range("A1").CurrentRegion.Rows.Count - 2).Clear End If For Each Sh In Sheets If Sh.Name <> "Result" Then m = 3 Do Until Sh.Cells(m, 2) = vbNullString OBJ(Sh.Cells(m, 2).Value) = vbNullString m = m + 1 Loop End If Next Sh Ar = Array(0, 0, 0, 0) If OBJ.Count Then t = 3 For Each ky In OBJ.keys For Each Sh In Sheets If Sh.Name <> "Result" Then Set F_rg = Sh.Range("B:B").Find(ky, lookat:=1) If Not F_rg Is Nothing Then '+++++++++++++++++++++++ ro1 = F_rg.Row: ro2 = ro1 Do Ar(0) = Ar(0) + Val(Sh.Cells(ro2, 5)) Ar(1) = Ar(1) + Val(Sh.Cells(ro2, 6)) Ar(2) = Ar(2) + Val(Sh.Cells(ro2, 9)) Ar(3) = Ar(3) + Val(Sh.Cells(ro2, 10)) Set F_rg = Sh.Range("B:B").FindNext(F_rg) ro2 = F_rg.Row If ro1 = ro2 Then Exit Do Loop '++++++++++++++++++++++++++ End If 'F_rg End If 'Sh Next Sh Res.Cells(t, 2) = ky Res.Cells(t, 3).Resize(, UBound(Ar) + 1) = Ar Ar = Array(0, 0, 0, 0) t = t + 1 Next ky With Res.Range("A3").Resize(t - 3, 6) .Columns(1).Value = _ Evaluate("Row(1:" & t - 3 & ")") .Borders.LineStyle = 1 .Font.Size = 14 .Font.Bold = True .InsertIndent 1 .Interior.ColorIndex = 35 End With End If 'dic.count End Sub الملف مرفق Ihab_ALL.xlsm

مافي داعي لهذه الجزئية ،وتابع معنا التعليق التالي 🙂 لتوضيح هذه المعلومة ، فينبغي عليك النظر الى الحدث ، سواء للنموذج او التقرير : . المجموعة رقم 2 ، الاحداث يوجد بها كلمة Cancel ، لذا يمكننا ان نستخدم الامر Cancel = True ، والبرنامج يقبله وينفذه ، بينما في المجموعة رقم 1 ، فالاحداث لا يوجد بها كلمة Cancel ، لهذا السبب الامر Cancel = True لن يعمل 🙂 وهذا يسري على الوحدات النمطية كذلك 🙂 جعفر

جرب الملف ربما يكون طلبك لاتنسى تفعيل الماكرو Aziz.xls

معالجة بيانات جدول الحصص في المشاركة السابقة لم أفعل شيء لمعالجة البيانات سوى أني قمت بإلة التنسيق المطبق على ورقة البيانات.. أما عن استخلاص البيانات من ورقة البيانات؛ فهذا يخضع للمتطلبات التي يحددها المبرمج.. وكمثال على ورقة بيانات: __ الطلب الأول استخلاص أسماء الطلاب وأرقامهم الأكاديمية.. في هذه الحالة لدينا خيارين: _ الأول استخلاص البيانات وعمل جدول جديد بتلك البيانات. _ الثاني استخلاص البيانات وإرسالها إلى جدول موجود مسبقا. __ الإشكالية التي تواجهنا بهذا الخصوص هي الاستطر الفارغة تحت كل اسم.. من واقع ورقة البيانات نعلم أن الأسطر الفارغة هي بيانات تكرارية لنفس الطالب أعلى الفرغات.. لحل هذا الاشكال ننشي استعلام مع حذف الفراغات، أما إذا كان هنالك بيانات متكررة فإننا نستخدم مع سبق عبارة DISTINCT __ التطبيق يمكن عن طريق معالج الاستعلامات، وأيضا عن طريق الشفرة وفي كلا الحالتين نستخدم جملة الاستعلام التالية SELECT DISTINCT F25 AS STID,F24 AS STNAME FROM [SCHEDULE$B16:END]AS STUDENTS IN 'schedules.xlsx'[EXCEL 12.0;] WHERE (NOT ISNULL(F25)) سوف أقوم بالشرح في المشاركة التالية Noor Data Processing.zip

الدرس الأول : ارفقت لك جزء من الجداول بعد اعادة صياغتها .. وهي الجداول الفرعية الخدمية 1- ادرس طريقة التصميم جيدا ( تسميات الجداول / وصف الجداول / تسميات الحقول / وصف الحقول / التسمية التوضيحية للحقول / خصائص الحقول ) بالنسبة الى وصف الحقول يمكنك الإسهاب في الوصف بحيث يعطي وصفا كاملا لوظيفة الحقل وعلاقاته ان وجدت 2- قم بتعبئة جميع البيانات كاملة في هذه الجداول 3- اعد رفع المرفق بالصيغة نفسها mdb .. بمعنى لا تتعبني في نقل الملف الى جهاز آخر لاني اعمل على اكسس 2003 فقط . 4- اللي عنده شغف حب التعلم يسأل عن كل صغيرة وكبيرة لم يفهمها .. وباب السؤال مفتوح في ما يخص الدرس لجميع اخواني الاعضاء المبتدئين . copy02.mdb

تفضل ..... المأموريات - 00.accdb

في هذا الملف 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