كل الانشطه

السلام عليكم هل يمكن ان اتوصل معك

أخي الكريم .. في الملف الجديد المرفق أمثلة يظهر فيها أهمية أن يكون البحث بعد اسم الكتاب وبخلاف ذلك ستحدث الأخطاء الأرقام الصحيحة في حقل (MNOX) وعدد الأخطاء في الملف (8) وكلها لنفس السبب وقد ميزتها بعلامة (1select) وهذا أحدها الدالة بحثت أولا عن اسم الكتاب (الطيوريات) ثم بحثت عن الرقم المطلوب وهو (135) ووجدتهما في (TAB) في الحديث رقم (30731) ولكنه ليس هو المطلوب لأن الرقم (135) الذي تم إيجاده ليس هو رقم الحديث في كتاب الطيوريات وإنما رقما لحديث في كتاب آخر ذُكر قبله قد يعد هذا الأمر مصادفة .. ولكنها كثيرة الحدوث لا بد من البحث عن الرقم بعد اسم الكتاب والرقم الصحيح للحديث المطلوب كما في حقل (MNOX) هو : (62993) ويمكن استعراض أحاديث (BOOKS) وما يقابلها من الملف الرئيسي (TAB) من خلال نموذج (BOOKS) وبالنقر المزدوج على رقم (MNOX) يظهر الحديث الصحيح المطلوب Smart_Search_New01.accdb

جزاكم الله خيرا

حيث لا يوجد تجاوب من منشيء المشاركة على أسئلة الأعضاء فإن المشاركة لا تستحق التثبيت، وسوف أقوم بإنزالها.

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

بالنسبة لرسالة الخطأ الاولي فيمكن حلها بأكثر من طريقة استبدل الكود tabRS.MoveLast tabRS.MoveFirst بهذا On Error Resume Next tabRS.MoveLast tabRS.MoveFirst On Error GoTo 0 اما بخصوص البحث عن الرقم فانا ابحث عن الرقم في كل الحديث لا يهم ان كان قبل النص او بعده في حال كان ناتج البحث 1 فلا يوجد مشكلة في حال كان هناك أكثر من ناتج اقم بتحديد موقع الرقم ومن ثم اذهب الي الوراء حتي اجد اول الرقم ومن ثم اذهب للأمام حتي اجد اخر الرقم وذلك حتي نتمكن من استخراج الرقم ومقارنته بالرقم الأصلي فاذا تطابق نعتمد هذا الناتج وذلك حتي نستطيع التمييز بين 312 و 1312 اذا امكنك مشاركة قاعدة بها احتمالات أكثر حتي نحاول بإذن الله من إيجاد حلول مناسبة

نأمل كتابة العنوان يصف الموضوع ولو بشكل مختصر

السلام عليكم لو سمحت ازاي اعمل ترقيم تلقائي مع السنة بحيث اني لو ادخلت بيانات لسنة قديمة وقمت باضافة سجل جديد يكمل علي السنة الجديدة لانه بياخد اكبر رقم ويقوم بكتابة الرقم التالي مع السنة الجديدة

جزاك الله خيرا أخي الكريم .. وأنا بحاجة لوقت لاستيعاب هذه المستجدات .. والآن تركيزي على التجارب بعد التجربة على ملف أكبر قليلا خرجت هذه الرسالة وبقي (188) حديثا من أصل (282) لم يعمل فيها الكود وعند مراجعة نتائج ما عمل فيه الكود ظهرت بعض الأخطاء التي مرجعها إلى وجود الرقم المطلوب قبل اسم الكتاب لذلك لا بد من البحث عن الرقم بعد اسم الكتاب وما قبله لا اعتبار له لذلك انا عندما كنت أجري التجارب الأولية -لكوني أعشق التجارب- خطر على بالي إعداد نص خاص للبحث يحذف كل النص الذي قبل اسم الكتاب المطلوب ليكون البحث فيما بعده، وهذا يقتضي أن أعد نصا خاصا لكل اسم كتاب .. وهذا حل غير عملي بالطبع 😁

يسعدني اكتساب هذه المعلومة بصدق

مثال للتجربه الاصناف.accdb

لا داعى للاسف فانت استاذى تمام كده بارك الله فيك

ارفع نموذج للعمل علية ويمكن استخدام دالة Replace اذا فهمت طلبك صح 'مثال txtInput.Value = Replace(txtInput.Value, " ", "__") وهذا مثلا عند حدث عند التحديث

عندي في الاكسيس مربع تحرير وسرد عايز لما اعمل مسافه يضيف كلمه ___ او ____ مثال مثلا اختارت في المربع كلمه سكر بعد الضغط علي مسطرة تضاف كلمه او سكر او زيت او دقيق

شكرا جزيلا يا استاذنا الفاضل وربنا يبارك فيك ويجعله في ميزان حسناتك

أرجو لك من الله التوفيق وبانتظار نتائج تجاربك لقد قمت بالتعديل علي الملف الأخير الذي قمت بمشاركته 1- اضفت موديول لحساب الوقت حتي تتمكن من حساب وقت العملية 2- قمت بالتطبيق علي الكود ( It Takes | 14MS | To resolve | 21 | Records. ) 3- قمت بتعديل ( Dim totalRec As String ) إلي ( Dim totalRec As Long ) النسخة بالمرفقات والأكواد المعدلة في أخر الموضوع كما أود الإشارة الي هذا السطر في الكود If totalRec Mod 1000 = 0 Then DoEvents وظيفته بشكل مختصر هي توقف تنفيذ الكود كل 1000 سجل حتي يتمكن البرنامج من التحرر وتلقي التحديثات ويحد من مشكلة عدم الاستجابة "Not Responding" لذا يمكنك التعديل علي الرقم 1000 بما يتناسب مع استخدامك مع الاخذ في الاعتبار ان هذا يؤثر علي الوقت الإجمالي للعملية يوجد فيديوهات تشرح الامر بالتفصيل ( كما يمكنك الاطلاع علي الرابط التالي https://wellsr.com/vba/2018/excel/vba-doevents-and-when-to-use-it/ 1- Timer Class MODULE ATTACHED 2- الكود بعد التعديل وتطبيق استخدام (Timer Class MODULE) Public Sub mnoSmartSearch() Dim db As DAO.Database Dim rs As DAO.Recordset Dim tabRS As DAO.Recordset Dim tblName As String Dim sqlStr As String Dim foundMno As String Dim exNum As String Dim stext As String Dim totalRec As Long Dim sPos As Long Dim startPos As Long Dim endPos As Long Dim i As Long Dim sTimer As ahmosTimer Dim itTakes As String tblName = "BOOKS" If DCount("*", tblName) = 0 Then MsgBox "There are no records in the table " & tblName, vbExclamation + vbOKOnly, "No Records Exist Error" Exit Sub End If Set sTimer = New ahmosTimer sTimer.StartTimer Set db = CurrentDb Set rs = db.OpenRecordset(tblName, dbOpenDynaset) With rs .MoveLast .MoveFirst totalRec = .RecordCount Do While Not .EOF sqlStr = "" foundMno = "" If Not IsNull(!BookName) And Not IsNull(!B_Hno) Then sqlStr = "SELECT TAB.MNO, TAB.NASS " & _ "FROM TAB " & _ "WHERE TAB.NASS LIKE '*" & Nz(!BookName, "") & "*' " & _ "AND InStr([NASS],'" & Nz(!B_Hno, "") & "') > 0;" Set tabRS = db.OpenRecordset(sqlStr, dbOpenSnapshot) tabRS.MoveLast tabRS.MoveFirst If tabRS.RecordCount = 0 Then ' No Results found Debug.Print "NotFound", !BookName, !B_Hno ElseIf tabRS.RecordCount = 1 Then ' One Result Found and that what we want foundMno = Nz(tabRS!MNO, "") If foundMno <> "" Then .Edit !MNO = foundMno .Update End If Else ' more than one record found and that shouldn't happen ' Debug.Print "Found Times is : " & tabRS.RecordCount, rs!BookName, rs!B_Hno Do While Not tabRS.EOF sPos = 0 i = 0 startPos = 0 endPos = 0 exNum = "" stext = "" stext = tabRS!NASS sPos = InStr(1, stext, rs!B_Hno) i = sPos Do While i > 0 And IsNumeric(Mid(stext, i, 1)) i = i - 1 Loop startPos = i + 1 ' Move forward to find the end of the number i = sPos Do While i <= Len(stext) And IsNumeric(Mid(stext, i, 1)) i = i + 1 Loop endPos = i - 1 exNum = Mid(stext, startPos, endPos - startPos + 1) If rs!B_Hno = exNum Then .Edit !MNO = Nz(tabRS!MNO, "") .Update Exit Do End If tabRS.MoveNext Loop End If If Not tabRS Is Nothing Then tabRS.Close Set tabRS = Nothing End If Else ' BookName or B_Hno are Empty Debug.Print "BookName or B_Hno are Empty" End If .MoveNext If totalRec Mod 1000 = 0 Then DoEvents Loop End With If Not rs Is Nothing Then rs.Close Set rs = Nothing End If If Not db Is Nothing Then Set db = Nothing sTimer.StopTimer itTakes = sTimer.GetElapsedTime If Not sTimer Is Nothing Then Set sTimer = Nothing Debug.Print "It Takes | " & itTakes & " | To resolve | " & totalRec & " | Records." End Sub Smart_Search03_byAhmos.accdb ahmosTimer.zip

TRY.xlsx

السلام عليكم كنت محتاج انقل المبلغ المناسب حسب الوظيفة ومرفق الاكسيل نقل المبلغ.xls

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

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

السلام عليكم مشكورين على جهودكم الطيبة محتاج إضافة على الملف المرفق إضافة بحث وإظهار النتائج يوزر فورم١.xlsb

رائع رائع رائع هو المطلوب بالضبط بارك الله في صحتك انت ومن تحب

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

وعليكم السلام ورحمة الله تعالى وبركاته بما انك لم تقم باظافة اليوزرفورم تمت اظافته من المشاركة السابقة لك والاشتغال عليه بنفس الفكرة ربما هدا ما تقصده Dim depart, Cnt, comment Private Sub UserForm_Initialize() comment = " تحديد ورقة العمل" Me.Label1.Width = 900 depart = Me.Label1.Left Message = " برنامج المخازن يرحب بكم . صل على محمد" Me.Label1.Caption = "**********" & Message & "**********" & Message & "************" Cnt = Len(Me.Label1.Caption): Me.ComboBox1 = comment End Sub '**************************** Private Sub UserForm_Activate() Me.Label1.Visible = True For x = depart To -(2.8 * Cnt - depart) Step -1 Me.Label1.Left = x w = 0.04 temp = Timer Do While Timer < temp + w DoEvents Loop Next x UserForm_Activate End Sub '*********************** Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal Y As Single) Set dico = CreateObject("Scripting.Dictionary") For Each c In ActiveWorkbook.Sheets dico(c.Name) = "" Next c dico.Remove (ActiveSheet.Name) Me.ComboBox1.List = dico.keys Me.ComboBox1.SetFocus End Sub '*********** Private Sub ComboBox1_Change() On Error Resume Next Sheets(CStr(ComboBox1)).Activate Me.ComboBox1 = comment End Sub يوزر فورم.xlsb

امممم دي آخر إجابة ليك ؟؟؟؟؟؟ 😎 يعني لو اتنقل لمربع نص تاني واستخدم Alt+F11 مش هيفتح محرر الأكواد ؟؟؟ 😉 ولا انت فكرني يا حج إني مخدتش بالي ان الحدث في الكومبوبوكس بس مش في حدث النموذج اروح انا فين بس