jjafferr

وعليكم السلام اللي شايفه ان المطلوب هو الكلمات اللي بينها مسافة ، لهذا نستطيع استعمال الدالة 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

اما الجزء الاخير من السؤال وهو عرض التقرير بالشكل الذي تفضلت به ، فممكن عمله ، وبما ان البيانات التي عندك في اكثر من جدول ، فيجب عليك عمل استعلام تجميعي Union Query لدمج بيانات هذه الجداول في استعلام واحد (تذكر لما اخبرتك باستعمال جدول واحد لجميع الايام ، فهذا سيسهل العمل في هذه الخطوة ، مثلا) ، فالجدول tbl_LessonAbsent فيه جميع الحقول المطلوبة ، فما عليك الا ان تعمل تقرير منه ، وبديكور قليل ، فيصبح مثل الصورة التى ارفقتها جعفر

وثانيا في التقرير: عندك: . . ولكنه كان يجب عليك ان تجمع اسماء الطلبة ، ثم تسلسل التاريخ: . والنتيجة: . جعفر

السلام عليكم هذا الموضوع من سنة 2006 ، فآخر زيارة لصاحب الموضوع في المنتدى كان في 8/9/2012 ، لذلك لا نتوقع عمل اي تحديث لرابطه الذي لا يعمل. الموضوع يُغلق. جعفر

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

1. ما دام الجدول عندك جاهز , فرجاء ارفاقه ، والا سأضطر انا لعمل الجدول 2. اللي افهمه من شرحك هو: السعر 1.2 + 6. = 1.8 وليس 2.5 !! معلش ، اخذ من وقتك اكثر شوي واشرح بمثال عن كيف تريد ان تكون النتيجة النهائية جعفر

طيب ممكن توضيح السؤال بطريقة مفصلة اكثر ، ومثال من واقع برنامجك ، ويا ريت صورة كذلك!! جعفر

وعليكم السلام السؤال غير واضح ، فلوسمحت تعطي توضيح اكثر. جعفر

وعليكم السلام اخي محمد 1. اذا اردت استعمال الكود الذي ذكرته انت ، فيجب تغير ترتيب اسطر الكود كالتالي: DoCmd.OpenForm "اسم النموذج", , , "[id]=" & Me![ID] DoCmd.Close acForm, "Search" لأنك اذ اغلقت النموذج Search قبل فتح النموذج الثاني ، فكيف ستحصل على قيمة ID من نموذج مغلق وعليه ، فيجب عليك ذكر اسم النموذج الذي تريد اغلاقة (بعد فتح النموذج الثاني) ، لأنه عندك الان نموذجين مفتوحين ، وبدون ذكر اسم النموذج ، فان الكود سيغلق النموذج الذي في المقدمة /الواجهة ، وهو النموذج الذي فتحته الآن ، يعني فتحته واغلقته 2. استعمال طريقتك التي ذكرتها ، هي نتيجة ان نموذج البحث منبثق ، لذلك وجب عليك فتح النموذج الثاني وغلق نموذج البحث ، اما انا ، فنادرا استخدم نموذج منبثق ، لذلك ، لا داعي لأغلاق نموذج البحث ، حيث ان النموذج الثاني سيملئ الشاشة ويغطي على نموذج البحث طبعا الكل عنده اسبابه في عمل النماذج مثل ما يتناسب مع برنامجه ، ولكن وللأسف الشديد ، اصبح موضوع النماذج والتقارير المنبثقة شبه عادة يستعملها الكثيرون ، ومعظمهم يستخدم هذ الطرق حتى يعطي لبرنامجه جمالا ، او حتى لا يُشعر المستخدم انه يستخدم اكسس هنا تُرجح الخبرة وفي الواقع اذا حصل لي ربكة في كود معين ، فانا ابحث عن كود سابق عملته ، او حتى اطلب من اكسس ان يُريني مثال اقتدي به جعفر

وعليكم السلام تماشيا مع شرح الموضوع السابق: زاليك الطريقة لسؤالك: . . جعفر

وعليكم السلام احذف السطر الاول في الكود ، استخدم السطر الثاني: 'DoCmd.OpenForm "full", , , " =[filenumber]" & Me.filenumber DoCmd.OpenForm "full", , , "[filenumber]=" & Me.filenumber جعفر

تم اضافة المرفق الى مشاركتي السابقة جعفر

وعليكم السلام احفظ هذه الوحدة النمطية: Option Compare Database Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias _ "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long '~~> Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) '~~> Class name of the Inputbox If Left$(strClassName, RetVal) = "#32770" Then '~~> This changes the edit control so that it display the password character *. '~~> You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If '~~> This line will ensure that any other hooks that may be in place are '~~> called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function ثم استدعها من نموذجك هكذا: intinput = InputBoxDK("فضلاً ادخل الرقم السري", "دخول") جعفر وتفضل المرفق بعد اضافة الكود فيه 456.حماية نموذج.mdb.zip

وعليكم السلام شوف هالرابطين ، فقد تستفيد منهم: و جعفر

وعليكم السلام استاذنا الجليل عبدالعزيز كانت عندك معادلة Dsum هنا: . فتم نسخها وتعديل المتغير [Name] الى نموذجك المطلوب فيه التغيير ، ولكن ولأنه حقل محسوب تتغير قيمته طول الوقت ، فإجعله غير مضمن ، ولا تحفظ قيمته في الجدول: . والنتيجة . جعفر 453.Aziz.accdb.zip

مع الاعتذار لك أخي عبدالله ، هذا الموضوع سوف يُغلق ، لأنه مكرر: جعفر

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

وعليكم السلام اليك الاجابة بالصور ، ويمكنك التعديل كما تشاء . . . . جعفر 454.معرفة المكرر من البيانات.accdb.zip

هلا والله ، والله يسلمك ان شاء الله يا جماعة ، اخذوا هذه النصيحة من تجارب سنين: كل جدول تعملة ، لازم تضع فيه هذين الحقلين ، الرقم التلقائي (مفهرس) والتاريخ التلقائي جعفر

وعليكم السلام اليك الاجابة بالصور . . . . . . . . جعفر 452.ترتيب سجلات التقرير نفس ترتيب سجلات النموذج الفرعي.mdb.zip