كل الانشطه

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

أخي الكريم .. لا تزال الأخطاء نفسها لابد من البحث عن الرقم كاملا حتى لا يحصل خلط بين : (312) (1312) وأمثالها ولا بد من البحث عن الرقم بعد اسم الكتاب وإلا ستكون الأخطاء كبيرة تأكدت من هذا بعد التجربة على الملفات الأصلية لأنه توجد الكثير من الأرقام .. مثلا هذا الحديث في أوائل الملف الأصلي إذا كان البحث عن الرقم فقط فستعتمد الدالة رقم هذا الحديث عند البحث عن كل حديث رقمه (5) أو (113) أو (114) أو (66) أو (185) أو (293) أو (706) .. ..

أخي الكريم @nssj ، بداية دعني أوضح لك نقاط مهمة في الدوال التي تعمد على البحث داخل سجلات عن قيم غير ثابتو ولا تتبع اسلوب محدد في موضعها ، فإنه مع كثيرة السجلات والبيانات في الجداول مستقبلاً ستأخذ وقتاً أوطول كلما زادت كميوة الداتا في الجدول المستهدف للبحث فيه . وهذا أمر طبيعي ، وسأحاول جاهداً توظيف الكود ليكون سلساً وسهلاً في آلية عمله . ثانياً ، اعذرني لأني أحيانا لا أدقق في النتائج بشكل ممعن كصاحب الموضوع على العموم ، جرب هذا التعديل البسيط لجعل الكود بعتمد البحث عن الرقم بطريقتين:- الأولى حيث يتبع الرقم مباشرة اسم الكتاب، والثانية حيث يكون الرقم موجودًا داخل النص دون الالتزام بموضع محدد ، في الكود التالي ، وأخبرني بالنتيجة سريعاً الكود : Dim db As DAO.Database Dim rsBooks As DAO.Recordset Dim rsTab As DAO.Recordset Dim sql As String Dim bookNumber As String Dim found As Boolean Set db = CurrentDb() Set rsBooks = db.OpenRecordset("BOOKS") Do While Not rsBooks.EOF bookNumber = rsBooks!B_Hno found = False sql = "SELECT * FROM TAB WHERE NASS LIKE '" & rsBooks!bookName & " " & bookNumber & "%'" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) = Len(rsTab!bookName) + 2 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If If Not found Then sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) > 0 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If End If rsTab.Close Set rsTab = Nothing rsBooks.MoveNext Loop rsBooks.Close Set rsBooks = Nothing Set db = Nothing المرفق بعد التعديل :- Smart_Search03.accdb

ماشاء الله استاذ خليفه زادك الله علما هو بالضبط كما اريد بوركت الجهود

إنت المفروض تفرح على الشغل العدل ذا .. إنت مزعل نفسك ليش ؟!! 😅😂 لا توجد مشكلة مع السلاسل الطويلة مادم النتيجة فتاكة 👍🏻😉 وأحلى حاجة في شغلك أنه لايوجد بروق ورعود فيها ( إهتزاز ) زي ما عودنا الأكسس .. والحركة سلسة فيها ما شاء الله ☺️ تم إضافة الصور المتحركة لعيونك ياحبيب الملايين 😎👌

جزيل الشكر للمبدع ابوالبراء ياسر خليل ولاستاذنا الاستاذ حسونة حسين

حالا اخي الكريم .. أخوك فادي من الأردن تفضل أخي @qathi ، جرب هذه الفكرة التي تم فيها تعديل بسيط لإظهار معالج السكانر في حال وجوده :- Dim imgFileName As String Dim imgPath As String Dim WIA As Object Dim scanner As Object Dim imgFile As Object Dim MyPath As String imgPath = CurrentProject.Path & "\Data\JPG\" imgFileName = imgPath & Me.ID & ".jpg" If Dir(imgPath, vbDirectory) = "" Then MkDir imgPath End If If Dir(imgFileName) <> "" Then If MsgBox("الصورة موجودة مسبقاً. هل ترغب في استبدالها؟", vbQuestion + vbYesNo, "تأكيد الاستبدال") = vbYes Then On Error Resume Next Kill imgFileName On Error GoTo 0 Else imgFileName = imgPath & Me.ID & "_new.jpg" End If End If Set WIA = CreateObject("WIA.CommonDialog") On Error Resume Next Set scanner = WIA.ShowSelectDevice() On Error GoTo 0 If Not scanner Is Nothing Then On Error Resume Next Set imgFile = WIA.ShowAcquireImage() On Error GoTo 0 If Not imgFile Is Nothing Then On Error Resume Next imgFile.SaveFile imgFileName On Error GoTo 0 Me.Pic_Path.Requery Me.Pic_Path = imgFileName Else MsgBox "فشل في الحصول على الصورة من الماسح الضوئي!", vbExclamation, "خطأ" End If Else MsgBox "يرجى التأكد من توصيل الماسح الضوئي وتشغيله.", vbExclamation, "تنبيه" End If وهذا الموفق Scanner.accdb

أهلا وسهلا بأخي الكريم Foksh الدالة عملت في جميع الأحاديث لكن يوجد خطأ في موضعين والسبب هو عدم البحث عن الرقم كاملا، فحصل خلط بين [172 & 1720] [312 & 1312] ثانيا: لفظ نظري قولك وهذا قد يسبب بعض الأخطاء في حالة وجود حديث فيه اسم الكتاب المطلوب وفيه أيضا الرقم المطلوب البحث عنه قبل اسم الكتاب، كأن يكون رقما لكتاب آخر، أو حتى رقم آية في متن الحديث لذلك أضفت هذا الرقم في النص وعند ما جربت الدالة تأكدت ظنوني وأعطى النتيجة الخاطئة لذلك لا بد من البحث عن الرقم بعد اسم الكتاب ثالثا: أرجو أن تعمل الدالة بشكل جيد في الملفات الكبيرة، فقد جربت الدالة الأولى على أحد الملفات الجاهزة عندي للعمل وفيه أكثر من (7000) حديث، قبل ثلاث ساعات وإلا الآن لم تنهي الدالة عملها مما اضطرني لإجبارها على التوقف رابعا: التأكد من أن الدالة إن لم تجد الرقم أو النص المطلوب تنتقل لما بعده دون أن تتعطل أو تخرج رسالة خطأ Smart_Search03.accdb

استاذنا @Foksh ماشاء الله .. تعيش وتتهناء أن شاء الله .. انتظر ابدعاتك استاذنا الغالي وياريت اعرف اسمك الاول حتى اناديك كما تعودنا

تفضل أخي @خالد الماجد 2 ، رغم أن المنتدى مليء بهذه المواضيع ، ولكن بما أنك عضو جديد فأهلاً وسهلاً بك معا في عالمنا الصغير المتواضع في المرفق ستجد طريقتين ، في المديول الأول Hide&Show يتم استدعاء الالة في أول نموذج يعمل في المشروع بالجملة التالية HideAccess لإخفاء واجهة آكسيس ، وأيضاً على العكس تستطيع إظهار آكسيس بالجملة التالية ShowAccess . وفي المديول الثاني Hide_Access هناك أكثر من طريقة للعمل على هذا المديول ، فمثلاً :- لإخفاء واجهة آكسيس : fSetAccessWindow(SW_HIDE) لإظهار واجهة آكسيس : fSetAccessWindow(SW_SHOWNORMAL) لإظهار واجهة آكسيس بوضع التصغير : fSetAccessWindow(SW_SHOWMINIMIZED) لإظهار واجهة آكسيس بوضع ملئ الشاشة : fSetAccessWindow(SW_SHOWMAXIMIZED) Hide & Show.accdb

دا انا هادوس بالجامد

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

ولوو ،، دا يسعدني يا باشا بس ما تتكاش أوي يعني

يا استاذ @Foksh من النظرة الأولى واعتذر لان اليوم انا عند والدتى كانت نظرة سريعة العمل ماشاء الله تبارك الرحمن تسلم ايدك ولكن هل تسمح بالمراجعة والتعديلات على الاكواد

استناداً لفكرة أخي @Abo-Abd Allah ، تم التعديل بشكل بسيط على الكود بحيث يكون البحث داخل النص عن رقم الكتاب وليس ملزماً بموقع الرقم ، أرجو التحقق من النتائج أخي @nssj من الكود التالي :- Function UpdateBooksWithMNO() Dim db As DAO.Database Dim rsBooks As DAO.Recordset Dim rsTab As DAO.Recordset Dim sql As String Dim bookNumber As String Dim found As Boolean Set db = CurrentDb() Set rsBooks = db.OpenRecordset("BOOKS") Do While Not rsBooks.EOF bookNumber = rsBooks!B_Hno found = False sql = "SELECT * FROM TAB WHERE InStr(NASS, '" & bookNumber & "') > 0" Set rsTab = db.OpenRecordset(sql) If Not rsTab.EOF Then rsTab.MoveFirst Do While Not rsTab.EOF If InStr(rsTab!NASS, bookNumber) > 0 Then rsBooks.Edit rsBooks!MNO = rsTab!MNO rsBooks.Update found = True Exit Do End If rsTab.MoveNext Loop End If rsTab.Close Set rsTab = Nothing rsBooks.MoveNext Loop rsBooks.Close Set rsBooks = Nothing Set db = Nothing End Function Smart_Search_function.accdb

أخي الكريم ، عدة نقاط أرجو توضيحها لأني في البداية قرأت الموضوع بشكل سريع ( كنت في طريقي للعمل ) ، الآن كالتالي :- لنفترض أن لديك نموذج يحتوي مربع نص لاستخدامه للبحث ( على سبيل المثال ) وتريد كتابة البحث داخل الحقل NASS في الجدول TAB ( صحيح ) عن قيم عشوائية يتم كتابتها بشكل يدوي وليس قيم محددة ( صحيح ؟ ) . يعني مثلاُ النتيجة التي تريدها عند البحث عن " فوائد تمام (756) " القيمة مأخوذة من أحي بيانات سجل في الجدول TAB من الحقل NASS ، وعليه فأن النتيجة التي تريد عرضها في النموذج الفرعي للنتئج ماذا ستكون ؟؟؟؟؟؟؟؟ لا بأس في شرحك إلا أن الأمور قد تتداخل في بعضها

السلام عليكم ورحمه الله وبركاته وبها نبدأ تفضل اخي Option Explicit Sub Search_Transfer() Dim WS As Worksheet, cel As Range, lr As Long, Temp(), I As Long, J As Long, X Set WS = ThisWorkbook.Worksheets("Sheet2") lr = WS.Cells(Rows.Count, "R").End(xlUp).Row For Each cel In WS.Range("R5:R" & lr) If cel <> "" Then X = Application.Match(cel, WS.Columns(13), 0) If Not IsError(X) Then I = I + 1 ReDim Preserve Temp(1 To 15, 1 To I) Temp(1, I) = I For J = 2 To 15 Temp(J, I) = WS.Cells(X, J).Value Next J End If End If Next cel Temp = Application.Transpose(Temp) If I > 0 Then WS.Range("V5").Resize(I, UBound(Temp, 2)).Value2 = Temp End Sub

وعليكم السلام ورحمه الله وبركاته تفضل Sub Transfer_Non_Adjacent_Columns_Using_Arrays_By_Yasser_Khalil() Dim arr As Variant, i As Variant, cr As Variant, j As Long arr = Sheets("ورقة1").Range("A1").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(5, 8, 11, 15, 17, 20) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(1, 2, 3, 4, 5, 6) Sheets("ورقة2").Cells(1, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub

السلام عليكم وبها نبدأ ارفق ملف اخي للعمل عليه

إذا حضر الماء بطل التيمم اتفضل خد راحتك يا بروف 😉 😉 كده الاستاذ يعتبر أن مشكلته محلوله إن شاءالله ❤️ ❤️

السلام عليكم ورحمه الله وبركاته وبها نبدأ جرب هذا لعله طلبك Option Explicit Sub Sort4() Dim Ws As Worksheet Set Ws = ThisWorkbook.Worksheets("Sheet1") With Ws .Sort.SortFields.Clear .Sort.SortFields.Add Key:=.Range("E10:E13"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("F10:F13"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("G10:G13"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal .Sort.SortFields.Add Key:=.Range("H10:H13"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With .Sort .SetRange Ws.Range("E9:H13") .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With End Sub

تأكد من تفعيل الماكرو في ( مركز الوثوق > ضبط اعدادات الماكرو ) في جهاز العميل

مشكور لتعبك اخى هفحص الاوفيس عندى

ولكم جزيل الشكر مقدما الرجاء ماوفيسنا.xlsxن الساده الاخوه الاعزاء المساعده فى هذه المساله