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

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

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته 🙂 درسنا اليوم عبارة عن فكرة تجميلية لقاعدة البيانات وإظهار شاشة إنتظار عند الإنتقال بين النماذج.. فكرة لمعت وحبيت أوثقها قبل أن تطير بلا عودة 😅 متابعة ممتعة 🙂 حمل المثال من المرفقات .. Waiting Screen.accdb

انا اعمل على اكسس 2010 32بت عموماً الملف ليس به أكواد . 1- نصائح لعملك المستقبلي ( اسماء الجداول والحقول باللغة الانجليزية ) حتى لاترهق نفسك أو من يساعدك . 2- اغلق هذة القاعدة وافتح قاعدة جديدة واستورد البيانات اليها . وجرب ووافني بالرد .

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

اليك المرفق وهذه النتيجة عندي DD127.accdb

يا اخي حينما ترفع ملف ...ارفع الملف بمشكلتك ... مش ملف فيه مشاكل بالاساس وضح اين المشكلة ... في اي مربع نص

السلام عليكم و رحمة الله تم تبديل الاعمدة لتتوافق مع طلبك =IF(COUNTIFS($B$3:$B$22;F3;$C$3:$C$22;G3)>0;"مطابق";"غير مطابق")

ابشر .. سأنظر فيها .. امهلني فقط اجد الوقت

تفضل أخي . نموذج بحث شامل احترافى جميع الحقول فى الاكسس (1).accdb

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

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

كل الود والاحترام لاستاذ خليفة @kkhalifa1960 انت طبعا صاحب المبادرة في الاجابة ..ومادخلت الا لاثراء الموضوع

السلام عليكم ورحمة الله استخدم هذه المعادلة =IF(COUNTIFS($F$3:$F$22;B3;$G$3:$G$22;C3)>0;"مطابق";"غير مطابق")

بااااااااارك الله فيك وجزاك خيرا شكرا لك اخي العزيز

In worksheet module try Private Sub Worksheet_Change(ByVal Target As Range) Const SROW As Long = 6, EROW As Long = 12, SCOL As Long = 3, ECOL As Long = 6 Dim x, v, rng As Range, cel As Range, c As Long If Target.Column = 3 And Target.Row > 15 Then For c = SCOL To ECOL With Sheets(2) Set rng = .Range(.Cells(SROW, c), .Cells(EROW, c)) x = Application.Match(Target.Offset(, 1).Value, rng, 0) If Not IsError(x) Then For Each cel In rng If Not IsEmpty(cel) Then v = Application.Match(Val(cel.Value), Columns(Target.Offset(, 1).Column), 0) If Not IsError(v) Then Application.EnableEvents = False Cells(v, Target.Column).Value = Target.Value Application.EnableEvents = True End If End If Next cel End If End With Next c End If End Sub

محاولتي: المصنف_02.xlsx

1-لا تجعل الخلية L1 فارغة ولا تحتوي على اسم اي شيت 2-اذا كان النطاق من L2 و نزولاً فارغاً الكود يأخذ كل الصفحات وإلا الصفحات المحددة في هذا النطاق 3-عدم ترك خلايا فارغة بين اسماء الشيتات المطلوبة في العامود L تفضل الكود المطلوب Option Explicit Private Sub Worksheet_Activate() Application.EnableEvents = False fil_data_val Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$A$2" And Target.Count = 1 Then Call find_Please(Me, Range("a2")) End If Application.EnableEvents = True End Sub '++++++++++++++++++++++++++++ Sub find_Please(SH As Worksheet, Rg) Dim Principal As Worksheet Dim Ro% 'first found row Dim ACT_Ro% 'Actual row All Others found rows Dim m%: m = 4 Dim My_rg As Range 'find range with Criteria in cell(A2) Dim Mon_Array SH.Range("A4:F" & Rows.Count).Clear Set Principal = Sheets("serch") Mon_Array = Application.Transpose(Range("L2", Range("L1").End(4))) If UBound(Mon_Array) > Sheets.Count Then For Each SH In Sheets If SH.Name = Principal.Name Then GoTo Next_sh Set My_rg = SH.Range("C:C").Find(Rg, lookat:=1) If My_rg Is Nothing Then GoTo Next_sh Ro = My_rg.Row: ACT_Ro = Ro Do Principal.Cells(m, 1).Resize(, 5).Value = _ SH.Cells(ACT_Ro, 1).Resize(, 5).Value Principal.Cells(m, 6) = SH.Name m = m + 1 Set My_rg = SH.Range("C:C").FindNext(My_rg) ACT_Ro = My_rg.Row If ACT_Ro = Ro Then Exit Do Loop Next_sh: Next Else '================================================ For Each SH In Sheets If SH.Name = Principal.Name Then GoTo Next_sh1 If Application.CountIf(Principal.Range("L2:L50"), SH.Name) <> 0 Then Set My_rg = SH.Range("C:C").Find(Rg, lookat:=1) If My_rg Is Nothing Then GoTo Next_sh1 Ro = My_rg.Row: ACT_Ro = Ro Do Principal.Cells(m, 1).Resize(, 5).Value = _ SH.Cells(ACT_Ro, 1).Resize(, 5).Value Principal.Cells(m, 6) = SH.Name m = m + 1 Set My_rg = SH.Range("C:C").FindNext(My_rg) ACT_Ro = My_rg.Row If ACT_Ro = Ro Then Exit Do Loop End If Next_sh1: Next '==================================== End If If m = 4 Then _ MsgBox "Current Account Not Found": Exit Sub With Principal.Range("A4:F" & m - 1) .Borders.LineStyle = 1 .Font.Bold = True .Font.Size = 24 .HorizontalAlignment = 2 .VerticalAlignment = 2 .Interior.ColorIndex = 24 .InsertIndent 1 End With End Sub '++++++++++++++++++++++++++++ Sub fil_data_val() Dim S As Worksheet, T As Worksheet Dim dic As Object Dim i% Set S = Sheets("serch") Set dic = CreateObject("Scripting.Dictionary") For Each T In Sheets If T.Name = S.Name Then GoTo Next_T i = 2 Do Until T.Range("c" & i) = vbNullString dic(T.Range("C" & i).Value) = vbNullString i = i + 1 Loop Next_T: Next T With S.Range("A2").Validation .Delete .Add 3, Formula1:=Application.Transpose(Join(dic.keys, ",")) End With dic.RemoveAll: Set dic = Nothing Set T = Nothing: Set S = Nothing End Sub الملف مرفق Saerch_by_Special_sheets.xlsm

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

السلام عليكم إخوتي الاحبه أعضاء وأساتذة منتدانا الغالي أقدم كود يقوم بالبحث في سلسلة نصيه ويستخرج ( الكلمات العربيه - والكلمات الانجليزي - والأرقام ) وكل سلسلة في عمود المدى الإفتراضي عمود "A" أرجو التجربه إن وجدت اي ملاحظات أو أخطاء Public Sub Cnvrt_Ali() Dim L_A&, i& On Error Resume Next ThisWorkbook.VBProject.References.AddFromFile "C:\Windows\System32\vbscript.dll\3" On Error GoTo 0 With ActiveSheet L_A = .Cells(.Rows.Count, "A").End(xlUp).Row For i = 2 To L_A .Range("B" & i).Resize(1, 3).Value = S_Nm_Ali(.Range("A" & i).Value) Next i End With End Sub Private Function S_Nm_Ali(ByVal Nms As String) Dim E$, A$, Nm$ Dim V_r As Object Set V_r = CreateObject("VBScript.Regexp") On Error Resume Next With V_r .Global = True .IgnoreCase = True .Pattern = "\w|\n|\-|\(|\)|\&|\." A = Trim(.Replace(Nms, "")) .Pattern = "\D+" E = Trim(.Replace(Nms, "")) .Pattern = "[-?\d+(\.\d+)?|\u0600-\u06FF]" Nm = Trim(.Replace(Nms, "")) End With S_Nm_Ali = Array(A, E, Nm) Set V_r = Nothing End Function Ali_String.rar

اخي واستاذنا عباد .. رائع كود صغير وفعل كبير .. رائع يا اخي واستخدام رائع للصياغة ومرونة فى التعرف على مختلف النصوص والارقام رائع يا اخي

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

السلام عليكم و رحمة الله اخي السيد عبدالفتاح الحمد لله انه قد تم تنفيذ طلبك و الأخ الحبيب كيماس ... شكراً على مرورك و الأخ الحبيب خبور .... شكراً على مرورك و لقد وصلتني رسالتك عن طريق الأخ الخالدي و الأخ ابو احمد شكرا على مرورك ================ و لقد قمت بشرح عمل هذه الدالة على هذا الرابط http://excel4us.com/blog/?p=243 أتمنى ان يستفيد منها الجميع =============== دمتم في حفظ الله

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

السلام عليكم الاخ الحبيب /يحي حسين ----جفظه الله عمل اكثر من رائع بارك الله فيك وجزاك خيرا تقبل تحياتي وشكري

معادلة رائعة أستاذنا يحيى مشكور جدا

السلام عليكم و رحمة الله تفضل اخي شاهد المرفق Dic database.xlsx

السلام عليكم و رحمة الله و بركاته أخي السيد في الخلية B3 ضع المعادلة التالية =MID(A3,MATCH(1,IF(CODE(MID(A3,ROW(INDIRECT("1:"&LEN(A3))),1))>=192,1),0),255) و هي معادلة صفيف يجب ادخالها بالضغط على Ctrl+Shift+Enter و ستحصل على الجانب العربي من الخلية الأصلية و في الخلية C3 ضع المعادلة التالية =TRIM(LEFT(A3,LEN(A3)-LEN(B3))) و ستحصل على الجانب الانجليزي من الخلية الأصلية ================= دمتم في حفظ الله