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

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

بسم الله الرحمان الرحيم السلام عليكم اغلبيتنا يعلم بان الاكسل جيد في انشاء برامج حسابية صغيرة لاكن مع مرور الوقت و زيادة حجم قاعدة البيانات للبرنامج يصبح هناك نوع من البطئء و التشنج في البرنامج لان الاكسل عبارة عن جداولة الكترونية و ليس بقاعدة بيانات و ايضا كما نعلم بان الاكسيس جيد جدا بالنسبة الاكسل لاستخدامه كقاعدة بيانات وب بالفعل الاكسيس مازال لحد الان يستعمل كقاعدة البيانات في البرامج المتوسطة لذى فكرة في دمج الاكسل و الاكسيس معا للستفادة من قوة الاكسل في الجداول و الحسابات و جمال الفورم مع الاكسيس المتميز في قوة قاعدة البيانات و عدم تاثره كثيرا بكبر حجمها كما هو معمول مع لغات البرمجة الكبيرة ك c++ vb.net java python ...... اذن ستجدون في هذا الموضوع مثال شامل لربط الاكسل بالاكسيس فقط بالاكواد بحيث سنتعامل مع الاكسيس بسلاسة كبيرة وذلك استخدام اوامر sql مع vbq بسهولة كبيرة وتنفذ جميع الاوامر من حذف او اضافة او تعديل او التقارير المعروف بها الاكسيس من خلال الاكسل دون فتح ملف الاكسيس (في الحقيقة يفتح ملف الاكسيس لاكن لن تلاحظ ابدا بانه مفتوح) والعملية المتبعة في ذلك مقسمة الى ثلاث مراحل فتح اتصال مع الاكسيس تنفيذ اوامر sql (select insert update delete) غلق الاتصال مع الاكسيس لا اطيل عليكم و اترككم مع الملف و لاي استفسارات انا في الخدمة تحياتي للجميع و ارجو ان تستفيدو من الموضوع ConnectDatabaseAccess.rar

بسم الله والصلاة والسلام على رسول الله وعلى آله وصحبه ومن والاه ...إخوتي الكرام السلام عليكم ورحمة الله وبركاته أحببت أن أعرض عليكم بعض إمكانيات الإكسيل الرائعة في تنسيق الأشكال في حال عدم توفّر الفوتوشوب أو البرامج الرسومية الأخرى ليظهر الملف بشكل أنيق ... حبث أنه يتمتع بجماليات في الخط والشكل وتناسق الألوان لكنه بعود على الملف بشيءٍ من البطء وزيادة حجم الملف .. الارتباطات التشعبية تظهر على شكل شفاف كقطرات الندى في صباح ربيعي مزهر..عند وضع المؤشر عليها تدلك على الورقة الهدف. راجياً من الله تعالى أن ينال إعجاب حضراتكم. اسم المستخدم :admin كلمة السر 123 ...بعض أوراق العمل محمية دون كلمة مرور ... والسلام عليكم ورحمة الله وبركاته. مكابس بلوك.rar

السلام عليكم ورحمة الله وبركاته هذا الموضوع مما تكثر الحاجة اليه الاصل عند تسجيل الحضور هو ادخال الوقت والتاريخ الكامل General Date ثم التعامل معه من خلال الاستعلامات والوحدات النمطية وهذا التاريخ هو المعمول به في اجهزة الحضور عامة كقارىء البصمات وغيرها ، والملاحظ ان بعض الاخوة المبرمجين يقومون بجلب بيانات الحضور من الجدول المصدر والتعامل معها اثناء الجلب وتفكيك البيانات في جدول جديد خاص . وفي الصورة ادناه نموذج من الجدول المعدل وهو الذي سوف اعتمده في شرحي ومثالي المرفق علما اني افضل العمل مباشرة على مصدر البيانات الاصل ثم نستخدم الاستعلام لضم هذا الجدول مع جدول الاسماء وعمل تجميع دقائق الـتأخر خلال شهر ونستعين بوحدة نمطية صنعناها لحساب التأخر بالايام وحساب المتبقي من الدقائق ثم ترحيلها الى الشهر التالي كرصيد سابق وحساب الايام بناء على ساعات التأخر (يكون حسب النظام المتبع ) فيختلف من مؤسسة الى اخرى فمنها من يحسب اليوم بــ 5 ساعات تأخر أو 7 ساعات ... وهكذا وفي مثالي هذا جعلت اليوم ساعتي تأخر (120 دقيقة ) ويظهر جليا في الوحدة النمطية المستخدمة Public Function trhelSn(mnthID, uid As Integer) ' uid يمثل رقم الموظف في الاستعلام On Error Resume Next Dim i, ii, a1, a2, a3, a4 As Integer ii = mnthID ' يمثل رقم الشهر في الاستعلام a2 = 0 For i = 1 To ii a2 = a4 ' ترجع بالرصيد السابق للشهر التالي a1 = Nz(DLookup("secnd", "qryscnd", "monthx=" & i & "And nID =" & uid), 0) ' ترجع بحقل الدقائق الذي تم جمعه في الاستعلام a3 = (Nz(a1) + Nz(a2)) \ 120 ' ترجع بعدد الايام بناء على عدد الدقائق المعتمد وهي هنا 120 دقيقة a4 = (Nz(a1) + Nz(a2)) Mod 120 ' ترجع بالمتبقي من الدقائق في الشهر الحالي Next End Function ' مصطلح الشهر الحالي والشهر التالي باعتبار الابتداء من اول شهر فأول شهر في الاستعلام يعتبر الحالي ثم التالي .. التالي ... وهكذا وهذه هي النتيجة النهائية : احتساب التأخر بالدقائق وترحيل .rar

وعليكم السلام اخوي ابو عبدالله ايش رايك بهذه الطريقة ، اختيار اعضاء الفريق ، هو الذي يقرر التشكيل ، والكود يذكرك بالاعضاء المختارين ، كلما تختار الفريق: وهذا هو الكود: Private Sub List0_AfterUpdate() On Error GoTo err_List0_AfterUpdate List2.RowSource = "" List2.RowSource = "Select TypID,MemprName From MemprsTbl Where TypID=" & Me.List0.Column(0) 'everytime we click in List0, we look in Text4 items, 'every item in Text4, we select it in List2 'now show the items selected before, and exist Text4 now Dim x() As String 'split each line of Text4 based on vbCrLf x = Split(Nz(Me.Text4, ""), vbCrLf) 'loop through all the lines For i = LBound(x) To UBound(x) For j = 0 To List2.ListCount - 1 'now loop through List2 strSelected = Me.List2.Column(1, j) & ";" & Me.List2.Column(0, j) If x(i) = strSelected Then 'select List2 item if it is the same as Text4 Me.List2.Selected(j) = True End If Next j Next i Exit Sub err_List0_AfterUpdate: If Err.Number = 94 Or Err.Number = 9 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub Private Sub List2_Click() On Error GoTo err_List2_Click 'everytime we click in List2, we look in Text4 items, 'if there are Selected in List2, we leave it in Text4, 'if there are Not Selected in List2, we remove them from Text4 'loop through List2 items For i = 0 To List2.ListCount - 1 strSelected = Me.List2.Column(1, i) & ";" & Me.List2.Column(0, i) If Me.List2.Selected(i) Then 'is List2 item selected, add it to Text4 'but is it there already If InStr(Nz(Me.Text4, ""), strSelected) = 0 Then Me.Text4 = Me.Text4 & strSelected & vbCrLf End If Else 'Remove from Text4 Me.Text4 = Replace(Me.Text4, strSelected & vbCrLf, "") End If Next i Exit Sub err_List2_Click: If Err.Number = 94 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر 693.TestList2.mdb.zip

بسم الله الرحمان الرحيم السلام عليكم تحياتي لجميع اعضاء اوفيسنا المحترمين الموضوع ليس بجدبد فقد تم التطرق له من قبل الاستاد القدير عبد الله باقشير جازاه الله خيرا و ان شاء الله نراه بينانا في المنتدى عن قريب لمتابعتي المنتدى في الاونة الاخيرة رئيت عدت تسائلات عن البحث والتعديل في الجداول و رئيت العديد من الحلول فحاولة الاجتهاد و الوصول الى ابسط و اسهل طريقة لعمل ذلك لذى فكرة في برمجة فورم مرن يكون ملائم لاي جدول مهما كان عدد صوفوفه او عدد اعمدته و لكي يتمكن اي عضو مهما كانت معرفته بالبرمجة ضعيفة من استعماله بسهولة ووصلة الى هذا الفورم الذي ارجو ان اكون قد وفقت في فكرته وان يستفيد منه الاغلبية يتميز هذا البرنامج يجلب الجدول المستهدف للعمل عليه و امكانية البحث داخله بدلالة اي عمود من اعمدته كما ان البحث يتميز بالبحث بأول حرف من الكمة او اي جزء منها حسب احتياجك وايضا تتميز عملية البحث بالسرعة الفائقة لاني اعتمدت على المصفوفات للوصول الى ذلك و تعرفون قوة المصفوفات و فعاليتعها اما بخصوص التكستبوكس و الكمبوبكس فتنشأ برمجيا على حسب عدد اعمدة الجدول نأتي الان الى طريقة استعمال الفورم هذا مع ملفك الخاص اولا اذهب الى محرر الاكواد تجد موديل باسم ModulePublic تجد في بدايته هذين الكودين او التعريفين ان صح التعبير Public Const sNomFeuil As String = "data" 'اسم ورقة العمل التي تحمل قاعدة البيانات Public Const sTableau As String = "tbData" ' اسم جدول قاعدة البيانات اضن ان الامر واضح تصع اسم الشيت الذي يحوي الجدول مكان عبارة "data" واسم الجدول نفسه مكان عبارة "tbData" ملاحظة : يجب ان تكون قاعدة البيانات عبارة عن جدول لايهم عدد اعمدة ولا صفوفه المهم ان يكون جدول باتباعك الخطوات السابقة تكون قد انتهيت من ربط جدولك مع الفورم ثانيا نأتي الى الاعمدة التي تحتاج قوائم في مثالنا لدين العمود 4 و العمود الاخير يحتاجون ان يمثلو في الفورم على شكر قوائم (كمبوبكس) لتنفيذ ذالك قم بأنشاء القوائم الازمة في اي شيت تريد و اعطي كل مدى قائمة اسم معين في المثال الخاص بنا سمينا نطاق قائمة الجنس ب list1 كما هو موصح في الصورة ثم اذهب الى رأس العمود المستهدف قم بادراج تعليق له و اكتب داخل التعليق نفس اسم نطاق القائمة و انتهى الامر ارجو ان اكون قد وفقت في الشرح وان يستفيد أكبر عدد من الاعضاء من هذا العمل ملاحضة: تنسيق عرض اعمد اليست يكون بتنسيقك ععرض اعمدة الجدول نفسه من الشيت و الفورم يكتشف العمود الذي يحوي تواريخ تلقائيا اي ملاحظة او استفسار او اضافة تحتاجونها للفورم لا تترددو في طلبي اهدي هذا العمل الى الغائبين الحاضرين في قلوبنا الاخ ضاحي الغريب و الاستاد عبد الله باقشير تحياتي للجميع UserForm Flexibles.rar

الاصدقاء الاكارم تحية طيبة الكثير يسال عن طرق البحث في عدة حقول و غالبا ما تكون الطريقة هي استخدام الاستعلام و باضافة عدة معايير له لكن في بعض الاحيان لا يمكن تطبيق هذه المعايير على الاستعلام و نحتاج الى كتابة الكود يدويا في هذا التطبيق اقدم لكم طريقة بسيطة للبحث في جدول مكون من اربع حقول مع ملاحظة انه يمكن البحث ب 21 طريقة من خلال هذا المثال البسيط قد يسال البعض من اين تاتي 21 طريقة و لا يوجد في المثال سوى اربعة حقول الجواب : يمكنك البحث كالآتي 1 الرقم 2 الاسم 3 التاريخ 4 ملاحظات 5 الرقم و الاسم 6 الرقم و التاريخ 7 الرقم و الملاحظات ...... وصولا الى البحث في الحقول الربعة مجتمعة والله من وراء القصد DbSearch.rar

الان وصلت الفكرة اليك حل افضل بكثير من طريقتك عملت لك هذه الاستعلا الالحاق INSERT INTO Transactions ( Doc, Code, Item, Out, Notes ) SELECT [Forms]![Trans_top10]![Transaction subform].[Form]![Invoice] AS Doc, Order_Sub.Code, Order_Sub.Item, [Forms]![Trans_top10]![Transaction subform].[Form]![Out] AS Out, Order_Sub.Notes FROM Order_Sub WHERE (((Order_Sub.ID)=[Forms]![Trans_top10]![Combo0])); وفي خلف زر استخدمت هذا الكود Private Sub Command95_Click() Me.Transaction_subform.SetFocus DoCmd.SetWarnings False DoCmd.OpenQuery "q1", acViewNormal DoCmd.SetWarnings True End Sub اليك ملفك بعد تعديل Pro.rar

كي نفعل ذلك يجب ان نحتال على اكسل اليك هذه الحيلة: 1-قبل عملية النسخ قم باستبدال علامة"=" قي كل الورقة بأي شي اخر مثلاً "##^^" و ذلك من خلال الضغط على Ctrl+H والقيام يعملية الاستبدال Replace All بذلك تتعطل كل المعادلات في الورقة ( حيث لا يوجد "=" لتنفيذ المعادلة) 2-قم بنسخ الورقة الى المكان المطلوب 3- قم باستبدال "##^^" يعلامة "=" في الورقتين المصدر و الهدف

وعليكم السلام اختي تفضلي: . . جعفر

احذف هذا السطر من الكود "DoCmd.OpenQuery "Query3 او في الاخر الكود اكتب سطر لاغلاق الاستعلام bmn (2).rar

انا نزلت المرفق لكن ما فهمت ما هو المطلوب ... ممكن تتوضح اكثر بالتفصيل

السلام عليكم كان المفروض ان يكون هذا الموضوع كجواب للموضوع والمشكلة هي ان ارقام التسلسل بالعربي ، في كل من التقارير الفرعية ليست بالتسلسل المطلوب ، ولا السنه بالتسلسل الصحيح . نعرف اذا اردنا ان نعمل اكثر من عمود في التقرير ، فاننا نستعمل اعدادات الصفحة في التقرير . اذا التقرير بالانجليزي ، فكل شيء تمام وبالترتيب/التسلسل المطلوب ، ولكن للأسف لما نريد الاعمدة بالتسلسل العربي ، من اليمين الى اسفل ، ثم يُكمّل العمود الثاني من حيث انتهى الاول ، هكذا . فهنا يجب ان نقوم بمعالجة الموضوع بطريقتنا الخاصة استعنت بالبرنامج من الروابط اعلاه ، وعملت تجارب على عدة اعمدة: 2 الى 6 اعمدة ، وكتبت نتائجها في الاكسل ، لأرى النتائج بصورة مباشرة ، الحالي معناه ما يعطينا الاكسس ، والمفروض هو التسلسل الذي نسعى لعمله . وبعد التمعن في الارقام لعدة ايام ، توصلت الى ان هناك لوغاريثم معين يتماشى مع ارقام الاعمدة وتسلسلها ، وبعد تجربة عدة طرق توصلت لطريقة تعرض هذه الاعمدة بالطريقة التي نريدها 1. سنحتاج الى حقلين اضافيين في الجدول (لكل تقرير فرعي) ، حقل تسلسل الاعمدة (وسيكون مخفي ، باللون البرتقالي في الصورة ادناه) والذي سيعتمد عليه التقرير في فرز البيانات ، rpt2_Seq مثلا، وحقل للتسلسل الذي سنراه في التقرير ، Seq2 مثلا (الحقل الآخر في التقرير) ، 2. في التقرير ، هكذا نجعل فرز البيانات ، على اساس الحقل rpt2_Seq . وبما ان التقرير الرئيسي يحتوي على 3 تقارير فرعية (في برنامج الرابط اعلاه) ، . فوضعت الكود على حدث "التنسيق" لرأس التقرير Page Header ، وهذا هو الكود ، والذي نراه انه ينادي الدالة ("Call Seq_Records(2, "rpt2_Seq", "Seq2") ، لكل تقرير فرعي ، ويرسل عدد الاعمدة المطلوبة ، واسم حقلي التسلسل في الجدول للتقرير الفرعي: Option Compare Database Dim rst As DAO.Recordset Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) 'Seq the subform Records 'rpt2 Set rst = CurrentDb.OpenRecordset("Select * From qry_2 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt2_Seq", "Seq2") 'rpt3 Set rst = CurrentDb.OpenRecordset("Select * From qry_3 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt3_Seq", "Seq3") 'rpt4 Set rst = CurrentDb.OpenRecordset("Select * From qry_4 Where nationalty=" & Me.nationalty) Call Seq_Records(2, "rpt4_Seq", "Seq4") End Sub . وهذا كود الدالة ، والتي يمكن إخراجها من التقرير وجعلها وحدة نمطية مستقلة) : Function Seq_Records(N As Integer, Seq_fName As String, Seq_n As String) On Error GoTo err_Seq_Records 'N = Number of columns 'Seq_fName = Seq Field Name 'Seq_n = Seq rst.MoveLast: rst.MoveFirst RC = rst.RecordCount c_Columns = N 'Number of columns in the report r_Records = RC 'Number of Records in the report j_First = c_Columns 'Start rtp_Seq with this number Counter = 0 'each time reduce c_Columns by this Counter For i = 1 To RC rst.Edit rst(Seq_fName) = j_First rst(Seq_n) = i 'Debug.Print "rtp_Seq=" & j_First & vbTab & "Seq=" & i rst.Update 'rtp_Seq j_First = j_First + c_Columns 'rpt_Seq cannot be > RC If j_First > RC Then 'start Counter Counter = Counter + 1 'rpt_Seq re-calculate j_First = c_Columns - Counter End If rst.MoveNext Next i Exit_Seq_Records: rst.Close: Set rst = Nothing Exit Function err_Seq_Records: If Err.Number = 3021 Then Resume Exit_Seq_Records Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . والنتيجة: . كما عملت تقرير للتجربة وبه 4 اعمدة ، والذي ينادي الدالة هكذا ("Call Seq_Records(4, "rpt2_Seq", "Seq2") ، والنتيجة . جعفر 680.4.الاجازات.accdb.zip

كود مهم جدا ولا يمكن الاستغناء عنه تحديد ارقام الخطأ لرسائل الاكسس فيمكن تعطيلها او ترجمتها Private Sub Form_Error(DataErr As Integer, Response As Integer) MsgBox DataErr MsgBox DataErr & vbCrLf & Err.Description Response = acDataErrContinue End Sub

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

يفضل طرح موضوع جديد لكل طلب جديد تيسيراً للبحث فيما بعد

ربما ينال الاعجاب هذا الملف salimمحرك بحث.rar

لا بل تقدر جلب مجموعە قیم من استعلام الى استعلام اخر لكن نحن نحتاج لقاعدة مصغرة بها استعلام الاساسي وايضا نحتاج نعرف ما تريد ان نخرج منه الى استعلام اخر .. اي وضح لنا ماتريد مع تقدير

ممكن تضع مرفق للتغيير عليه On Error GoTo err: DoCmd.RunCommand acCmdSaveRecord DoCmd.GoToRecord , , acNewRec Exit Sub err: If err.Number = 3022 Then MsgBox "الرقم الذاتي مكرر", vbCritical + vbMsgBoxRight, "خطأ" Else MsgBox err.Description End If او قد يستطيع هذا الكود لمعالجة الخطأ مساعدتك لكن يفضل وجود مرفق

استخدم هذا Private Sub WorkScope_AfterUpdate() Dim rst As DAO.Recordset Dim D 'As Integer Dim X As Integer ' = Cycles Dim E ' = CSN Dim F ' = CSO Dim Z ' = VisitSeq Set rst = CurrentDb.OpenRecordset("Select * From qry_workscope_utility") rst.MoveLast: rst.MoveFirst X = rst!Cycles rst.MoveNext D = rst!VisitNo E = rst!CSN F = rst!CSO Z = rst!VisitSeq rst.MovePrevious If D = "NA" Then Else If IsNull(Form_frm_WORKSCOPE.VisitNo) Then rst.Edit rst!VisitNo = D + 1 rst.Update rst.Close: Set rst = Nothing Else End If End If If E = "NA" Then Else If IsNull(Form_frm_WORKSCOPE.CSN) Then rst.Edit rst!CSN = E + X rst.Update rst.Close: Set rst = Nothing End If End If If IsNull(Form_frm_WORKSCOPE.Visit_Seq) Or Form_frm_WORKSCOPE.Visit_Seq = "" Then rst.Edit rst!CSO = "" rst.Update rst.Close: Set rst = Nothing End If If Z = "0" Then rst.Edit rst!CSO = X rst.Update rst.Close: Set rst = Nothing End If If Z >= "1" Then rst.Edit rst!CSO = X + F rst.Update rst.Close: Set rst = Nothing End If Me.frm_WORKSCOPE.Requery End Sub اليك مرفقك qs-4.rar

مافي مشكلة ، طيب اخبرينا كيف تريدينا نشتغل على برنامجك المرفق؟ اعطينا مثال لوسمحتي جعفر

السلام عليكم ورحمة الله محاولة في الملف باستعمال الدالة SUMPRODUCT حسب فهمي للمطلوب.. بن علية حاجي a.rar

بعد اذن اخي ابو البراء بالمعادلات: في B2 ,اسحب نزولاً =LEFT(TRIM(A2),FIND("(",TRIM(A2))-1) في D2 اسحب نزولاً =SUBSTITUTE(MID(TRIM(A2),(FIND("*",TRIM(A2))),((FIND("سعر",TRIM(A2)))-(FIND("*",TRIM(A2)))-1)),"*","")+0

البداية للنسخ هو آخر صف حيث يتم عمل تعبئة تلقائية لآخر صف ... ولمدى عدد الصفوف المطلوبة طبقاُ للمتغير c الذي يشير للخلية Q1

جرب إضافة السطرين التاليين On Error Resume Next sh.Range("A" & lr + 1).Resize(c, lc).SpecialCells(xlCellTypeConstants).ClearContents بعد هذا السطر في الكود sh.Range("A" & lr).Resize(1, lc).AutoFill Destination:=sh.Range("A" & lr).Resize(c + 1, lc)

بعد اذن معلمنا العزيز ملك الاكواد ياسر خليل لو احتجت الى كود يمكن استخدام هذا الكود اثناء فتح البرنامج Private Sub Workbook_Open() ActiveWindow.DisplayWorkbookTabs = False End Sub

اتفضل اليك هذا الكود Private Sub Command0_Click() Dim obj As AccessObject, dbs As Object Set dbs = Application.CurrentProject For Each obj In dbs.AllForms If obj.IsLoaded = True And obj.Name <> Me.Name Then DoCmd.Close acForm, obj.Name, acSaveYes End If Next obj End Sub واليك ملفك بعد تعديل CloseForm.rar

السلام عليكم ورحمة الله تم عمل المطلوب في الخلايا الملونة بالأخضر... تم أيضا التعديل على معادلات كل من أعمدة (الطلاب الغائبون - نسبة أكثر من 75 % - نسبة 50 % إلى 75 %)... أرجو أن تفي الغرض المطلوب... أخوك بن علية حاجي الصفين الرابع والخامس الإبتدائي 2016-2017م.rar

اسف نسیت ذلك تقدر تعمل فراغ في نهاية الكلام اللي بين " " في كلا اتجاهين اي سيكون "تم اعطاء للسيد" الى " تم اعطاء للسيد " او تستخدم اقواس اذا تريد مثل هذا MSGBOX (" تم اعطاء للسيد " & " ( " & ME.NAMEFORMIREBIA & " ) " & "اکتب صلاحیات" )

نعم سيكون علامة صح امامه لكن اذا ضغطت على لا سيلغي علامة صح امامه

السلام عليكم ورحمة الله استخدم هذا الكود Sub Tra_Data() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, i As Long, j As Long, p As Long Dim Arr As Variant, Temp As Variant Set ws = Sheets("بيانات الطلاب") Set sh = Sheets("سجل 41 مستجدين") LR = ws.Range("C" & Rows.Count).End(xlUp).Row Arr = ws.Range("B17:T" & LR).Value ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If True Then p = p + 1 For j = 1 To 13 Temp(p, Choose(j, 1, 2, 3, 4, 5, 6, 10, 11, 12, 13, 14, 16, 17)) = Arr(i, Choose(j, 1, 2, 7, 8, 9, 10, 13, 4, 14, 15, 16, 11, 12)) Next End If Next If p > 0 Then sh.Range("B8").Resize(p, UBound(Temp, 2)).Value = Temp End Sub

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

جرب الكود التالي لعله يفي بالغرض (ومن غير شريط تقدم هيكون سريع إن شاء الله) Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim p As Long Dim sW As Double Dim sM As Double Set ws = Sheets("Data") Set sh = Sheets("Report") arr = ws.Range("B2").CurrentRegion.Value ReDim temp(1 To UBound(arr, 1), 1 To 2) For i = 2 To UBound(arr, 1) If arr(i, 2) <> "" Or arr(i, 3) <> "" Then p = p + 1 temp(p, 1) = arr(i, 1) sW = sW + Val(arr(i, 2)) sM = sM + Val(arr(i, 3)) temp(p, 2) = sW - sM End If Next i With sh .Columns("E:F").ClearContents .Range("E3:F3").Value = Array("التاريخ", "الرصيد التراكمي") .Range("E4").Resize(p - 1, UBound(temp, 2)).Value = temp End With End Sub

افتح مصدر النموذج وهو استعلام القي نظرتا الى حقل سبجيكت انا كتبت Like "*" & [نماذج]![اسم النموذج]![اسم مربع نصي للبحث] & "*" تقدر تكتب في شرط اي حقل لكن لا تكتب في صف اللي انا كتبت الشرط بل اكتب في صف اسفل اللي انا كتبته لان اذا كتبت في نفس الصف سيعطيك نتائج اللي فيها شرطين واعتذر من الجميع اذا انا تجاوزت قوانين المنتدى

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

الـ Admin للمدينة لما يعمل صلاحية لأي شخص في مدينته ، فلن يستطيع ان يعملها لأي مدينة اخرى

طلب الي في احد المدارس تحويل علامات الطلاب من بيانات عامودية الى جدول قكان هذا الملف (وضعتة يتصرف المنتدى لمن يريد الاستفادة منه) Tanspose_notes.rar

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

استغر الله نحن في خدمتك

الفرق بينهما هو طريقتي بيعطيك ارقام سالب ايضا مثلا عندك سجل وقت دخول هو 11:44 ووقت الخروج هو 10:40 لذلك يعطيك سالب وعند سجل وقت الدخول 03:35 ووقت الخروج هو 05:40 لذلك يعطيك موجب اي طريقتي بيعطيك اللي رقمه الموجب فقط وتقدر ان تعمل لكي يعدد كل سجلات اي تحويل ارقام سالب الى الموجب وتعدده لكن الطريقة استاذنا @محمدنجار بيعطيك فقط ارقام موجب لذلك بيعدد كل سجلات

اتفضل انا عملت لك مشاهدة تلقائي خلال 3 ثواني تقدر تتغيره Pictures1.rar

بارك الله فيك من طيب قلبك اسال اللهع ان يجعل كل حرف تعلمناه منك استاذي ان يجلعه بميزان حسناتك

استأذن من استاذنا @محمدنجار انت کان استخدمت مع الکود کلمە و ولیس او الیک الکود Private Sub كود_الصنف_AfterUpdate() 'On Error Resume Next If Forms![فاتوره شراء]!التوجيه = "بيع" Or Forms![فاتوره شراء]!التوجيه = "مرتجع بيع" Then Me.السعر = Me.سعر_البيع ElseIf Forms![فاتوره شراء]!التوجيه = "شراء" Or Forms![فاتوره شراء]!التوجيه = "مرتجع شراء" Or Forms![فاتوره شراء]!التوجيه = "تحويل" Then Me.السعر = Me.سعر_الشراء End If End Sub وھذا ملفك بعد تعديل 1111111.rar

وعليكم السلام 1. انا غيّرت الحقل "رقم السند" الى نص ، 2. هذه الوحدة النمطية تقوم بعمل الترقيم Function Next_Seq(T As String) As String 'T = Type نوع السند 'A = سند ايردات 'M = سند مصروفات 'S = سند سداد 'G = سند قبض myGroup = "A = سند ايردات" & vbCrLf & _ "M = سند مصروفات" & vbCrLf & _ "S = سند سداد" & vbCrLf & _ "G = سند قبض" If Len(T & "") = 0 Then MsgBox "يجب ان يكون نوع السند" & vbCrLf & "A او M او S او G" & vbCrLf & vbCrLf & myGroup Exit Function ElseIf T <> "A" And T <> "M" And T <> "S" And T <> "G" Then MsgBox "يجب ان يكون نوع السند" & vbCrLf & "A او M او S او G" & vbCrLf & vbCrLf & myGroup Exit Function Else Next_Seq = Nz(DMax("Mid([رقم السند], 2)", "السندات", "Mid([رقم السند], 1, 1) = '" & T & "'"), 0) Next_Seq = T & Format(Next_Seq + 1, "00000") End If End Function وكلما اردت ان تحصل على رقم جديد في نموذجك ، اكتب هذا الكود: تذكر 'A = سند ايردات 'M = سند مصروفات 'S = سند سداد 'G = سند قبض me.[رقم السند]= Next_Seq("A") جعفر 698.3333.mdb.zip

او فقط في حدث تحميل التقرير اكتب Private Sub Report_Load() Me.Filter = "[saf] = 10 And [ksm] = 1" Me.FilterOn = True End Sub

أخي الكريم صلاح جرب الكود التالي ويمكن وضعه في حدث فتح المصنف .. أو كما ترغب فيما بعد Sub OpenClosedWBs() Dim wbk As Workbook Dim ws As Worksheet Dim strInput As String Dim i As Long Dim p As Long Dim lr As Long Application.ScreenUpdating = False On Error Resume Next Set ws = ThisWorkbook.Sheets("Sheet1") For i = 2 To ws.Cells(Rows.Count, "H").End(xlUp).Row p = InStrRev(ws.Range("H" & i), "\") + 1 strInput = Mid(ws.Range("H" & i), p) Set wbk = Workbooks(strInput) If wbk Is Nothing Then Set wbk = Workbooks.Open(Filename:=ws.Range("H" & i)) If wbk Is Nothing Then MsgBox ws.Range("H" & i) & " Not Found!", vbCritical Exit Sub End If End If With wbk.Sheets(1) Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1).Activate End With Set wbk = Nothing Next i On Error GoTo 0 Application.ScreenUpdating = True End Sub

بعد إذن حبيبنا شيفان يمكن استعمال المعادلة الآتية DSum("Field", "Table", "Field > 0") حيث table اسم الجدول و field اسم الحقل الموجود به الأرقام

تم تحميل البرنامج برنامج ممتاز