jjafferr

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

السلام عليكم اخي علي ، انت لم تشر الى طلبك الاخير في هذا الموضوع ، وانما كان في موضوع آخر ، لهذا السبب انا والاخ محمد اعطيناك الاجابة الصورة المرفقة لنموذج فيه اسماء العمارات ، وهنا تُدخل العدد الذي تشاء بالنسبة للشقق ، فتلاحظ انه عندك 9 عمارات (لاحظ عدد السجلات في اسفل النموذج) ، بينما للعمارة1 ، فان فيها شقتين (النموذج الفرعي): . جعفر 451.مثال.accdb.zip

!!

اختي ، الشئ الوحيد في المرفق هو الجدول1 ، ولم توضحي اين تريدين نتائج التقطيع!! والاكسس ليس مثل الاكسل ، فالاكسس محتاج يحفظ بياناته في مكان ، والاستعلام مجرد وسيله لفك الكلمات ، ولكنه ليس مكان الحفظ!!

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

النتيجة في الجدول 2

تفضل هذا استعلام تحديث للحقل Retour: . بينما اذا كنت في نموذج فتستطيع عمل حدث بعد التحديث للحقلين Leave_Date و Dure حتى يقوموا بتحديث التاريخ: Private Sub DURE_AfterUpdate() On Error Resume Next Me.RETOUR = Me.Leave_Date + Me.DURE End Sub Private Sub Leave_Date_AfterUpdate() On Error Resume Next Me.RETOUR = Me.Leave_Date + Me.DURE End Sub . اما أخي رمهان فكان قصده: بما ان برنامجك accdb (وليس mdb) ، فيمكنك استخدام خاصية جديدة في الجدول يسمى حقل محسوب ، حيث سيقوم بحساب المطلوب دون الحلجة الى استعلام او كود ، هكذا: . جعفر 466.VACN.accdb.zip

تفضلي حولت الكود الى وحدة نمطية ، وستلاحظين اني الغيت اسطر من الكود ، لان الجملة ستاتي من الاستعلام (والاستعلام ليس استعلام سجلات جديدة ، انما هو استعلام تحديد ، حيث يحدد السجلات المطلوب تفكيك كلماتها ويرسلها للوحدة النمطية ، والتي تقوم بالتفكيك): Function Split_Click(Letters, Record_ID) Dim x() As String ' Dim rstFrom As DAO.Recordset Dim rstTo As DAO.Recordset 'busy hour glass ON ' DoCmd.Hourglass True 'set both tables for In/Out data ' Set rstFrom = CurrentDb.OpenRecordset("Select * From Table1") Set rstTo = CurrentDb.OpenRecordset("Select * From Table2") 'clear the Record number sent from Table2, so that we start again CurrentDb.Execute ("Delete * From Table2 Where [code]='" & Record_ID & "'") 'move the cursor to the first Record ' rstFrom.MoveLast: rstFrom.MoveFirst ' rcFrom = rstFrom.RecordCount 'count the records 'read all the records, one at a time ' For iFrom = 1 To rcFrom 'split the required field, based on empty spaces x = Split(Letters, " ") 'iterate through these splited words For i = LBound(x) To UBound(x) 'add them to the second table, and update the record rstTo.AddNew rstTo!code = Record_ID rstTo!word = x(i) rstTo.Update Next i 'move to the next record ' rstFrom.MoveNext ' Next iFrom 'busy hour glass OFF ' DoCmd.Hourglass False 'clearing the memory ' rstFrom.Close: Set rstFrom = Nothing rstTo.Close: Set rstTo = Nothing End Function . تم اضافة حقل جديد في الجدول Table1 ، حتى تختارين السجلات التي تريدين تفكيك كلماتها ، واستخدام هذا الحقل كشرط في الاستعلام: . جعفر 463.1.index.mdb.zip وهذا الرابط به شرح من اخونا العود ابوخليل جعفر

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

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

وعليكم السلام اخي نبيل اعتذر منك ، فانا الذي ترك اسم الموضوع مجردا من @@@@ وجوابا على سؤالك ، فالجمع ممكن ينعمل على عدة طرق ، منها (ولنفترض ان اسم حقل تاريخ بداية الاجازة هو Leave_Date ، ومدة الاجازة 5 ايام): MsgBox 5 + Me.Leave_Date او MsgBox DateAdd("d", 5, Me.Leave_Date) جعفر

انا قلت Webcam كان قصدي Webcam ، وكاميرا DSLR مثل Nikon D500 و Canon

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

وعليكم السلام عندك طريقتين لعمل هذا: 1. طريقتي التي عملتها في معظم برامجي ، اضع نص خلف الصورة ، اكتب فيها: الصورة غير موجودة (او شئ من هذا القبيل) ، هذه الطريقة جدا خفيفة على البرنامج 2. تعمل جدول خاص ، وتضمن فيه هذه الصورة فقط (وتتأكد انها صغيرة طولا وعرضا ، حتى لا تأخذ مساحة كبيرة من برنامجك) ، ثم في النموذج الذي به صورة الموظف ، في حدث الفتح (حيث انه يقوم بتنفيذ الكود قبل جلب البيانات من الجداول) ، نقول للكود: تأكد من وجود صورة الموظف من مجلده ، اذا وُجدت ، ونستطيع استخدام الدالة Dir مثلا في هذا الخصوص . وإلا تأكد من وجود الصورة الافتراضية ، وهي صورة واحدة ، ويجب ان تكون في مجلد images_company مثلا ، وإلا فيقوم بعمل المجلدات المطلوبة ، ونسخ هذه الصورة الافتراضية من الجدول الى مجلد images_company ثم على حدث التحميل نضع هذا الكود: اعرض صورة الموظف من مجلده ، اذا وُجدت ، وإلا اعرض الصورة الافتراضية ، وهي صورة واحدة ، ويجب ان تكون في مجلد images_company مثلا جعفر

وعليكم السلام . . . . . . جعفر 464.حذف المكرر من البيانات وعزله في جدول اخر.accdb.zip

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

تفضلي هذا الكود Private Sub cmd_Split_Click() Dim x() As String Dim rstFrom As DAO.Recordset Dim rstTo As DAO.Recordset 'busy hour glass ON DoCmd.Hourglass True 'set both tables for In/Out data Set rstFrom = CurrentDb.OpenRecordset("Select * From Table1") Set rstTo = CurrentDb.OpenRecordset("Select * From Table2") 'clear Table2 CurrentDb.Execute ("Delete * From Table2") 'move the cursor to the first Record rstFrom.MoveLast: rstFrom.MoveFirst rcFrom = rstFrom.RecordCount 'count the records 'read all the records, one at a time For iFrom = 1 To rcFrom 'split the required field, based on empty spaces x = Split(rstFrom!Field1, " ") 'iterate through these splited words For i = LBound(x) To UBound(x) 'add them to the second table, and update the record rstTo.AddNew rstTo!code = rstFrom!ID rstTo!word = x(i) rstTo.Update Next i 'move to the next record rstFrom.MoveNext Next iFrom 'busy hour glass OFF DoCmd.Hourglass False 'clearing the memory rstFrom.Close: Set rstFrom = Nothing rstTo.Close: Set rstTo = Nothing End Sub . والنتيجة . جعفر 463.index.mdb.zip

لوسمحتي ترفقي قاعدة بياناتك ، وبها الجداول المطلوبة ، وتخبرينا اين تريدين الحفظ جعفر

وعليكم السلام اللي شايفه ان المطلوب هو الكلمات اللي بينها مسافة ، لهذا نستطيع استعمال الدالة Split هكذا مثلا: dim x() as string x=split(me.text," ") for i=lbound(x) to ubound(x) msgbox x(i) & " - " & me.id next i جعفر

تفضل . . جعفر 461.بحث بالحرف الابجدى.accdb.zip

حياالله اخوي عمر الله إنشاءالله يسلمك ويعافيك من كل سوء دنيا وآخرة، ومن احببت جعفر

حيا الله أخونا العود ابوخليل في التقرير ، me.page يعني رقم الصفحة التي فتحها التقرير الان ، والتي بها نكتب رقم الصفحة ، بينما me.pages معناها رقم الصفحة الاخيرة من التقرير بهذه الطريقة ، نطلب من الاكسس ، بانه اذا كنا على الصفحة الاخيرة من التقرير ، نخفي ذيل الصفحة ، مع جميع البيانات في ذيل الصفحة ، وحتى اخفاء اي كائن فيها ، مثل كائن عمل صفحة جديدة والشئ الجدا مهم في التقرير ، هو وضع الحدث في المكان/الجزء الصحيح من التقرير ، فالتقرير قد يحتوي على عدة اجزاء (رؤوس وتذييل لمجموعات مختلفة) ، وكل منها يحمل نفس الحدث (يعني حدث التنسيق مثلا موجود في راس الصفحة وفي ذيل الصفحة ايضا) ، والصور المتحركة في الرابط التالي توضح قصدي: . جعفر

تفضل استعمل هذا الكود في التقرير في حدث التنسيق لذيل التقرير (كما هو موضح في الكود) : Private Sub PageFooterSection_Format(Cancel As Integer, FormatCount As Integer) If Me.Page = Me.Pages Then Me.PageFooterSection.Visible = False Else Me.PageFooterSection.Visible = True End If End Sub وهو سيخفي الخانات الحمراء من الصفحة الاخيرة جعفر

السلام عليكم انا بحثت عن مثل هذا سؤال ، فوجدت الرابط التالي ، ومرفق صورة من النتيجة ، وملف الاكسل ايضا: https://excelxor.files.wordpress.com/2015/02/which-numbers-add-up-to-total-multiple-solutions2.xlsx . وكذلك وجدت مثال على vba واضطررت التعديل عليه ليناسب طلبك ، فهذه الوحدة النمطية الاساسية: Option Compare Database Option Explicit Dim rst As DAO.Recordset ' 'from 'http://stackoverflow.com/a/21076070 'Edited by jjafferr on 29/11/2016 ' Function SumTarget() Dim numbers(0 To 6) As Double Dim target As Double Dim i As Integer target = DSum("[Price]", "t1") / 2 Call modArray_StatesInAnArray For i = 0 To Record_Count - 1 numbers(i) = strState(i) Next i CurrentDb.Execute ("Delete * From tbl_Results") 'delete all the results from the table Set rst = CurrentDb.OpenRecordset("Select * From tbl_Results") 'set the table for the entries Call SumUpTarget(numbers, target) rst.Close: Set rst = Nothing End Function Public Sub SumUpTarget(numbers() As Double, target As Double) Dim part() As Double Call SumUpRecursive(numbers, target, part) End Sub Private Sub SumUpRecursive(numbers() As Double, target As Double, part() As Double) Dim s As Double, i As Double, j As Double, num As Double Dim remaining() As Double, partRec() As Double s = SumArray(part) 'If s = target Then Debug.Print "SUM ( " & ArrayToString(part) & " ) = " & target If s = target Then rst.AddNew rst![Target_Number] = target: rst!Results = ArrayToString(part) rst.Update ElseIf s >= target Then Exit Sub ElseIf (Not Not numbers) <> 0 Then For i = 0 To UBound(numbers) Erase remaining() num = numbers(i) For j = i + 1 To UBound(numbers) AddToArray remaining, numbers(j) Next j Erase partRec() CopyArray partRec, part AddToArray partRec, num SumUpRecursive remaining, target, partRec Next i End If End Sub Private Function ArrayToString(x() As Double) As String Dim n As Double, result As String 'result = "{" & x(n) result = x(n) For n = LBound(x) + 1 To UBound(x) 'result = result & "," & x(n) result = result & "+" & x(n) Next n result = result '& "}" ArrayToString = result End Function Private Function SumArray(x() As Double) As Double Dim n As Double SumArray = 0 If (Not Not x) <> 0 Then For n = LBound(x) To UBound(x) SumArray = SumArray + x(n) Next n End If End Function Private Sub AddToArray(arr() As Double, x As Double) If (Not Not arr) <> 0 Then ReDim Preserve arr(0 To UBound(arr) + 1) Else ReDim Preserve arr(0 To 0) End If arr(UBound(arr)) = x End Sub Private Sub CopyArray(destination() As Double, source() As Double) Dim n As Double If (Not Not source) <> 0 Then For n = 0 To UBound(source) AddToArray destination, source(n) Next n End If End Sub والتي تطلب البيانات من هذه الوحدة النمطية: Option Compare Database Const lngArraySize = 20 Public strState(lngArraySize) Public lngCounter As Long Public Record_Count As Integer Function modArray_StatesInAnArray() ' loads a list of states into an array of fixed size 'Const lngArraySize = 20 'Dim lngCounter As Long Dim varAState As Variant ' needs to be a variant for ' use in the ForEach loop 'Dim strState(lngArraySize) Dim db As Database Dim sl As Long Set db = CurrentDb lngCounter = 0 sl = 0 Dim rst As Recordset Set rst = db.OpenRecordset("Select * From t1") rst.MoveLast: rst.MoveFirst Record_Count = rst.RecordCount Do While Not rst.EOF 'If sl < 6 Then 'sl = sl + rst!price 'rst.Edit 'rst!priceSort = rst!price 'rst.Update 'this would cause a problem 'End If strState(lngCounter) = rst!price lngCounter = lngCounter + 1 rst.MoveNext Loop ' For I = 0 To lngCounter ' Debug.Print strState(I) ' Next I End Function ولتشغيل الوحدات النمطية ، نضع هذا الكود على حدث زر في النموذج: Call SumTarget والنتيجة تحفظ في الجدول tbl_Results: . جعفر 460.Database200.accdb.zip 460.which-numbers-add-up-to-total-multiple-solutions2.xlsx.zip