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

قيمة المحافظة من Combo Box هي قيمة العمود الأول المختفي وهي قيمة رقمية ويظهر العمود الثاني من مربع combo box به اسم المحافظة وفي حقل الاستعلام توجد قيمة نصية بها اسم المحافظة وليس قيمة رقمية كما بالنموذج وفي استعلامك فأنت تضع شرط ِ ب AND تقارن بين رقم المحافظة وهو = 1 وبين اسم المحافظة من الجدول وهي = مسقط وبالتالي لا تظهر بيانات لعدم تحقق الشرط وهناك طريقتان : إما أن تعدل الاستعلام وتضع به حقل كود المحافظة وتضع بها المعيار وأما أن تنشي مربع نص مخفي وتضع مصدر التحكم Control Source ثم تجعل شرط المحافظة في الاستعلام مستندا إلى اسم مربع النص هذا =[MOhafazh].[column](1) DATA- 1.rar

السلام عليكم الاسم "Total" هو اسم حقل في جدول بيانات (أو هو عنوان العمود O في الجدول) وبالتالي المعادلة في الخلية O6 (المكتوبة بالأعلى) هي عبارة عن مجموع الخلايا من النطاق الموجود في الصفين 8 و 9 (من العمود B إلى العمود O) والحقل (Total) يبين أنه يجب الاقتصار في هذا المجموع على الخلايا الموجودة في العمود O فقط من الصفين 8 و 9 وبالتالي فإن المعادلة في الخلية O6 هي باختصار مجموع الخليتين O8 و O9 (الرمز O يعني العمود O وليس الصفر 0)... أرجو أني وضحت معنى المعادلة في الملف... بن علية حاجي

استخدم OR لاضافة شرط آخر (Day([StartDate])=26 Or Day([StartDate])=1) واستخدم AND لاضافة شرط ثاني للتاريخ ليتحقق الشرطان معاً : مثلاً التحقق من أن يكون التاريخ المدخل أقل من 120 يوم قادمة : (Day([StartDate])=26 Or Day([StartDate])=1) And < Date()+120 التحقق من أن يكون التاريخ المدخل في فترة قبل 120 يوم سابقة : وهذا معناه أنه لن يقبل فترة حالية أو مستقبلية (Day([StartDate])=26 Or Day([StartDate])=1) And < Date()-120

وعليكم السلام اخى الفاضل @tiger wanted يفضل بعد ذبك وضع مثال لما تريد والشرح الوافى لما تريد ان شاء الله المثال التالى يلبى حاجتك كما فهمت فهل هذا ما تريد ؟ بالنسبه للاستعلام q جعلناه top100 SELECT TOP 100 ta.العمر, * FROM ta ORDER BY ta.العمر DESC; فالنموذج وضعنا مربع نص غير منضم اسمه txtTop لكتابه الرقم تحت حدث عند النقر للزر الكود التالى Private Sub btnTop_Click() Me.RecordSource = "SELECT TOP " & Me.txtTop & " ta.العمر, * FROM ta ORDER BY ta.العمر DESC;" End Sub بالتوفيق اخى db1.mdb

احتمال نعم كما بالصورة توزيع 21.accdb

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

اتفضل مثال بالتوفيق PageSum.mdb

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

للمرة الالف ( عدم تسمية الأوراق باللغة العربية) صجيج ان لغتنتا هي لغة القرآن الكريم ولغة الضاد ومن أجمل لغات العالم ونحن نفتخر فيها لكن للأسف لا تصلخ 100% للمعادلات والأكواد في اكسل (نسبة الخطأ تتعدى ال 90%) جربي كتابة اسم اي ورقة باللغة العربية وانظري مذا يجري تم حل الموضوع بالمعادلات (المعادلات محمية / ضد الكتابة فوقها / لعدم العيث بها عن طريق الخطا زلكنها ليست محمية ضد الحذف) المعادلة في الخلية C3 مع (Ctl+Shift+Enter) والسحب نزولاُ حتى الخلية C25 و لذلك الأمر بالنسبة للخلية D3 مع تغيير اسم الصفحة داخل المعادلة =SUM((Minho!$A$2:$A$1000>=$E$2)*(Minho!$A$2:$A$1000<=$F$2)*(INDIRECT("Minho!"&ADDRESS(2,(MATCH($A3,Minho!$A$1:$AA$1)),1)&":"&ADDRESS(1000,(MATCH($A3,Minho!$A$1:$AA$1)),1)))) With_formula.xlsm

هناك 4 طرق توزيع للطلاب بالمرفق : 1 - "صف مختلف + مادة مختلفة" 2 - "نفس الصف أو صف مختلف + نفس المادة أو مادة مختلفة" 3 - "صف مختلف + نفس المادة" 4 - "صف مختلف وتجاهل المادة" وهذا يحافظ على الترنيب طبقاً لرقم الجلوس والصف إن كانوا في ترتيب تسلسلي ولكن جميعها يستند لتوزيع المقعد الأول في كامل القاعات أولاً وهذا هو الهيكل الرئيسي أو العقل المدبر للكود الذي يمكن العمل عليه لاجقاً للتعديل و جاري تعديل الكود للاختصار وحذف الزيادات ، واذا أتيح الوقت فهناك طريقة اضافية للتوزيع المتزامن للمقعدين معاً بكل صف بالقاعة 'Start ..................... إنشاء الجدول المؤقت من جديد ........................ Call Clear_data_first 'start.......................................------ توزيع الحقل الأول بعدد نصف الصفوف ---- الطلاب ................. DoCmd.RunSQL "INSERT INTO Table1 ( Seat1_class, Seat1_Exam, Seat1_name, Jloss1_no ) " _ & "SELECT Qry1.Safe, Qry1.[N-EXSAM], Qry1.St_name, Qry1.Jloss_no FROM" _ & "(SELECT TOP 50 PERCENT Jloss_tpl.Jloss_no, * FROM Jloss_tpl " _ & "ORDER BY Jloss_no , Jloss_tpl.Safe, Jloss_tpl.[N-EXSAM], Jloss_tpl.St_name ) Qry1;" DoCmd.RunSQL GetSQL.update_action 'start......................................... توزيع الحقل الثاني ............................................. Set rsQry = CurrentDb.OpenRecordset(GetSQL.select_action) Set rsTbl = CurrentDb.OpenRecordset(GetSQL.select_tbl1) 'start......................................... المرور على سجلات الجدول المؤقت لإضافة الطالب بالمقعد الثاني ............................................. For h = 0 To rsTbl.RecordCount Set rsQry = CurrentDb.OpenRecordset(GetSQL.select_action) rsQry.MoveFirst 'start......................................... المرور على سجلات الاستعلام من الجدول الاساسي لاختيار طالب حسب الشروط للمقعد الثاني ............................................. For i = 0 To rsQry.RecordCount 'start................... دالة اختيار طالب واحد عشوائي لأول ثلاثة اختيارات من الكومبوبكس Set rsQry = CurrentDb.OpenRecordset("SELECT top 1 Jloss_no , * FROM Jloss_tpl WHERE (((Jloss_tpl.Action) = False) ) ORDER BY rnd(Jloss_no),Safe;") s = Nz(DLookup("Jloss2_no", "Table1", "[Jloss2_no] = " & rsQry!Jloss_no & ""), 0) ' شرط عدم اختيار مسبق y = (Val(rsTbl!Seat1_Exam) <> Val(rsQry("N-EXSAM"))) ' شرط اختلاف المادة x = (Val(rsTbl!Seat1_Exam) = Val(rsQry("N-EXSAM"))) ' شرط تشابه المادة 'start................................. اختيارات طريقة التوزيع من النموذج Select Case Combo_choice Case 1 If IsNull(rsTbl!Seat2_name) And rsTbl!Seat1_class <> rsQry!Safe And s = 0 And y = True Then: Call dist Case 2 If IsNull(rsTbl!Seat2_name) And s = 0 Then: Call dist Case 3 If IsNull(rsTbl!Seat2_name) And rsTbl!Seat1_class <> rsQry!Safe And s = 0 And x = True Then: Call dist Case 4 'start................... إعادة اختيار بدون العشوائية للمحافظة على ترتيب رقم الجلوس للاختيار الرابع من الكومبوبكس Set rsQry = CurrentDb.OpenRecordset("SELECT Jloss_no , * FROM Jloss_tpl WHERE (((Jloss_tpl.Action) = False) ) ORDER BY Jloss_no;") s = Nz(DLookup("Jloss2_no", "Table1", "[Jloss2_no] = " & rsQry!Jloss_no & ""), 0) If IsNull(rsTbl!Seat2_name) And rsTbl!Seat1_class <> rsQry!Safe And s = 0 Then: Call dist End Select Next ' السجل التالي للاستعلام If rsTbl.EOF Then: rsTbl.MoveFirst: Else: rsTbl.MoveNext Next ' السجل التالي الجدول توزيع 20.accdb

أيوه كده-تمام عليك اولا بفهم النطاق المعرف اولا والمسماه بــــ Plan_EmployeeCosts وذلك كما بالصورة اما الخلية O$5 فهذا الأمر بسيط وهو رقم الخلية الموجود بها كلمة Total

استنادا لقيمة ثابتة : Me.Recordset.FindFirst "[id] = 3" واستنادا لمتغير : Me.Recordset.FindFirst "ID=" & Me.Text1

طيب جرب الملف بعد التعديل DATA- 4.rar

تم التعديل ملاحظة (أرقام الأعمدة يمكن ان لا تتطابق في صفخات Minho & Laha )لذلك يجب ادراج عامود اضافي لهذه الأرقام في صفحة Repport ) لا وقت لدي لعمل ذلك (تركت أرقام الأعمدة للصفخة Minho) Option Explicit Sub Extact_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Application.ScreenUpdating = False Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum#, My_count% Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("A2").Resize(26, 3).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": GoTo Leave_Me_Olone St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 26) For I = 1 To 26 arr(I) = I Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 '++++++++++++++++++++++++++++++++++++++++ With M For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_M - 1)) If My_count = 0 Then GoTo NexT_it For I = 2 To Lr_M If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = it: R.Cells(RO, 2) = IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_it: Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_L - 1)) If My_count = 0 Then GoTo NexT_itm For I = 2 To Lr_L If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 3) = IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_itm: Next it End With '++++++++++++++++++++++++++++++++++++ Leave_Me_Olone: Application.ScreenUpdating = True End Sub الملف( للمرة الثّالثة) From_To Row_Column_1.xlsm

السلام عليكم ورحمة الله عفوا اخى الكريم اجعل الكود بهذا الشكل يعمل معك مدى الحياة فقط يمكنك التعديل من خلال الكود الخلية تريد ظهور التاريخ فيها و الشكر موصول لاخى الرائد77 Private Sub Workbook_Open() Dim i As Integer i = Year(Date) j = Month(Date) If j < 7 Then Sheets("Sheet3").Range("A1").Value = "7 / 1 / " & i - 1 Else Sheets("Sheet3").Range("A1").Value = "7 / 1 / " & i End If End Sub

كان من الواجب التوضيح في بادىء الأمر لعدم تضييع الوقت بأمور فائدة منها الكود الجديد Option Explicit Sub Extarct_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum# Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("B2").Resize(25, 2).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": Exit Sub St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 25) For I = 1 To 25 arr(I) = I + 3 Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 With M For Each it In arr For I = 2 To Lr_M If .Cells(I, it).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it)), .Cells(I, it), 0) End If Next I R.Cells(RO, 2) = IIf(My_sum > 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr For I = 2 To Lr_M If .Cells(I, it).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it)), .Cells(I, it), 0) End If Next R.Cells(RO, 3) = IIf(My_sum > 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 Next End With '++++++++++++++++++++++++++++++++++++ End Sub المرفق من جديد (الماكرو الاول ما زال يعمل اذا لزم الأمر باستعماله) From_To Row_Col.xlsm

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

هذا الكود يقوم بما يلزم تغيير اسماء الصفحات الى اللغة الأجنبية لحسن نسخ الكود ولصقه Option Explicit Sub Extarct_Data() Rem Created By Salim Hasbaya on 29/5/2020 Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO% Dim St_Date As Date, End_Date As Date Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("B2").Resize(25, 2).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": Exit Sub St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 2) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With '++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone RO = 2 For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 R.Cells(RO, 3) = Application.Sum(.Cells(I, 4).Resize(, 26)) RO = RO + 1 End If Next I End With End Sub الملف مرفق From_To.xlsm

تفضل .. اطلع على نموذج العملاء .. مع الأخذ في الحسبان ما يلي : 1- تم تغيير مسميات الحقول في الجداول إلى الانجليزية .. 2- تم اضافة كود خاص لرقم العميل من أجل التسلسل . بحيث لو حذفت سجل يتم تريتيب أرقام العملاء بالتسلسل في الجدول . 3- عند فتح النموذج يكون مباشرة يفتح على آخر سجل حتى يتم معرفة الرقم لآخر سجل . 4- تعديل تصميم النموذج .. 5- فيما يخص تسجيل التاريخ الهجري في الجدول فمازالت المشكلة قائمة ( مرة يسجل و100 مرة ما بيتسجل في الجدول ) لعل ذوي الخبرة يفزعون لنا . @jjafferr @أحمد الفلاحجى @Barna وغيرهم ... 6- بعد أخذ رايك في الموضوع نستطيع ان شاء الله نكمل جدول ( الجلسات ) T1.accdb

وعليكم السلام ورحمة الله وبركاته جرب الملف ربما يكون فيه طلبك لا تنسى تفعيل الماكرو لكي تشتغل الازرار تحياتي Test1.xlsm

وعليكم السلام ع حسب ما فهمت فى حدث عند الصفحه ضع الكود التالى Private Sub Report_Page() MsgBox "هذا التقرير يتكون من عدد " & Pages & " صفحه " End Sub بالتوفيق

جرب التالي TEST (1).accdb

السلام عليكم .. لدي تقرير يحتوى عدة سجلات ... والتقرير قابل للنمو .. هل هناك طريقة برمجية لإظهار رسالة تفيد بعدد صفحات التقرير قبل طباعته .؟ بمعنى ... لو كان التقرير الذي سيتم معاينته أو طباعته يتكون من أكثر من صفحة تظهر رسالة تنبيه

كل عام والجميع طيبيين وبخير برنامج دول وعواصم افريقيا تعديل روابط التحميل برنامج دول وعواصم افريقيا رابط البرنامج على موقع Top4top وشغال كويس https://top4top.io/downloadf-1608vsi831-rar.htm

شكراً استاذ أحمد الفلاحجى أبو بسمله وتقبل تحياتي .

اهلا بك فى المنتدى , يمكنك هذا بالدالة المعرفة ConvertDate ... بوضع هذه المعادلة بالخلية D5 سحباً للأسفل وهذا هو كود الدالة Option Explicit Function ConvertDate(ByRef StringIn As String) As String Dim savedCal As Integer Dim d As Date Dim s As String savedCal = Calendar Calendar = 1 d = CDate(StringIn) Calendar = 0 s = CStr(d) ConvertDate = Format(s, "dd/mm/yyyy") Calendar = savedCal End Function المصنف1.xlsm

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

لا تكتبي مجموع بل Sum او اي شيء احر باللغة الاجنبية Summation مثلاً على كل حال كتابة اي شيء لا يكون تاريخاً يتم تجاهله

لا أرى اي كلمة محموع في minho و لا في laho

تم معالحة الأمر dATA_Ameel _Updated.xlsm

استاذنا الفاضل / @اشرف بارك الله فيك كيف الطريقة ان امكن توضيح اكثر

ناصرالمصرى هل انت من أنصار عدم الضغط على الإعجاب وتقدير مجهود الأساتذة الذين لهم الفضل عليك بعد ربنا فى حل مشكلتك وهذا اقل ما يقدم لهم على مجهوداتهم وأوقاتهم المهدرة معك فى حل مشكلتك ؟!! يجب عليك الضغط على الإعجاب ؟!!!💙

السلام عليكم اخونا الأمير هشام نعم يمكن مشاركة قاعدة بيانات عن طريق الانترنت بوسيط هذا الوسيط هو موقع ZeroTier https://my.zerotier.com/login واي استفسار ان شاء الله جاهزين

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

تم التعديل (بالمعادلات صعبة قوي) From_To Rows_Columns_Adv.xlsm

كده هتكون بداية الفترة Date()-120 ونهايتها Date() (Day([StartDate])=26 Or Day([StartDate])=1) And >=Date()-120 And <=Date()

تفضل استاذي العزيز ارجو ان يكون طلبك هذا فيما يخص شروط حقل Virusm لكن لم افهم قصد فيما يخص منع تكرار الاسم في الحقول TEST1.rar

ممكن تلافي مشكلة الأعمدة بأدراج الأرقام غلى شكل X/y حيث تدل X على الصفحة "Minho" و y تدل على الصفخة "Laho" و في حال كان الرقم منفرداً يكون في الصفحة "Minho" تعديل الكود Option Explicit Sub Extact_Data_By_Columns() Rem Created By Salim Hasbaya on 29/5/2020 Application.ScreenUpdating = False Dim M As Worksheet, L As Worksheet, R As Worksheet Dim Rg_M As Range, Rg_L As Range Dim I%, Lr_M%, Lr_L%, RO%, it Dim St_Date As Date, End_Date As Date Dim arr, My_sum#, My_count% Set M = Sheets("Minho"): Set L = Sheets("Laho") Set R = Sheets("Repport") Lr_M = M.Cells(Rows.Count, 1).End(3).Row Lr_L = L.Cells(Rows.Count, 1).End(3).Row R.Range("A2").Resize(26, 3).ClearContents If Not IsDate(R.Range("D2")) Or Not IsDate(R.Range("D2")) Then _ MsgBox "Type Please Correct Dates In The Cells D2 and E2 ": GoTo Leave_Me_Olone St_Date = Application.Min(R.Range("D2:E2")) End_Date = Application.Max(R.Range("D2:E2")) ReDim arr(1 To 26) For I = 1 To 26 arr(I) = I Next '++++++++++++++++++++++++++++++++++++++++ With M .Range("A2:AC" & Lr_M).Interior.ColorIndex = xlNone For I = 2 To Lr_M If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With ''++++++++++++++++++++++++++++++++ With L .Range("A2:AC" & Lr_L).Interior.ColorIndex = xlNone For I = 2 To Lr_L If .Cells(I, 1) <= End_Date _ And .Cells(I, 1) >= St_Date Then .Cells(I, 1).Resize(, 29).Interior.ColorIndex = 6 End If Next I End With RO = 2 '++++++++++++++++++++++++++++++++++++++++ With M For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_M - 1)) If My_count = 0 Then GoTo NexT_it For I = 2 To Lr_M If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = it: R.Cells(RO, 2) = _ IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_it: Next it End With '++++++++++++++++++++++++++++++++++++ RO = 2: My_sum = 0 With L For Each it In arr My_count = Application.CountA(.Cells(2, it + 3).Resize(Lr_L - 1)) If My_count = 0 Then GoTo NexT_itm For I = 2 To Lr_L If .Cells(I, it + 3).Interior.ColorIndex = 6 Then My_sum = My_sum + _ IIf(IsNumeric(.Cells(I, it + 3)), .Cells(I, it + 3), 0) If .Cells(I, it + 3) <> vbNullString Then .Cells(I, it + 3).Interior.ColorIndex = 35 End If End If Next I R.Cells(RO, 1) = _ IIf(R.Cells(RO, 1) = vbNullString, it, it & " \ " & R.Cells(RO, 1)) R.Cells(RO, 3) = _ IIf(My_sum <> 0, My_sum, vbNullString) My_sum = 0: RO = RO + 1 NexT_itm: Next it End With '++++++++++++++++++++++++++++++++++++ Leave_Me_Olone: Application.ScreenUpdating = True End Sub

بيض الله وجهك .. كنت عملتها منظمة لكنها لم تضبط معي .. فاعترف وقل لي ايه اللي عملته ؟؟ ههههههه هل كان هناك تعديل في الكود أو الخصائص ؟؟

كل عام وأنتم بخير وهذة هدية ووسام شرف غالي من منتدى عظيم مليئ بالأستاذة الكبار علماً وخلقاً والتزاماً فكل الشكر والتقدير لفريق الموقع ولأساتذتي وزملائي على هذه الثقة وأتمنى أن أكون عند حسن الظن

جرب هذا الملف MENhOLAHO.xlsm

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

اخي aladdin61 نحدد الخلاياء ثم من تنسيق الخلاياء نختار قائمة محاذاه ثم نختار احتواء مناسب

وعليكم السلام اتفضل هل هذا ماتريد بالتوفيق اخى cars.rar

جرب هذا الملف تم حماية الصفحة لعدم العيث بالمعادلات عن طريق الخطا (بدون باسورد) dATA_Ameel.xlsm

وعليكم السلام 🙂 . 1. نعم مثل ما كتب اخوي احمد ، 2. نعم تستطيع عمل هذا: اكتب هذا الكود في "عند تنسيق" "قسم التفصيل" Detail : if me.pages > 1 then msgbox "توجد اكثر من صفحة في التقرير" end if جعفر

وعليكم السلام هذه بعض الاشياء التي يجب النظر فيها: يجب ان يكون البرنامج مقسما الى الجداول BE (وهذا الذي تضعه في الشبكة) ، والواجهة FE وفيه بقية الكائنات (ويكون على كمبيوترات المستخدمين) ، يجب ان تكون بعض الحقول مفهرسة في الجدول ، وهذه الحقول هي التي تستخدمها كمعيار في الاستعلام مثلا ، يجب ان تتأكد من الاستعلامات بالذات معمولة بطريقة لا تبطئ البرنامج والاكسس هنا يساعدك فيخبرك اين مكان المشكلة في برنامجك يجب ان تستخدم اسلاك بسرعة 1000 مثل cat 6 ، و Switch او Router بسرعة 1000 (Giga) . جعفر

. أفا ، شو هالكلام أخوي سعيد ، بالطريقة هاي الطبخة ما تكون كاملة . حيا الله أخوي ابواحمد 1. مثل ما يقولون: مسكتني من ايدي اللي توجعني ، لكن ولا يهمك ، ما يصير خاطرك إلا طيب ، غالي والطلب رخيص 2. بس عطني كم يوم ، عندي شغل مستعجل ، أخلصه وارجع لكم بالمثال ان شاء الله . أخي مؤمن تحديث بقية الكمبيوترات ، سيتم بالطريقة اللي شرحتها انا في مشاركتي السابقة جعفر

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

كأنك تريد ان تطبع استكرات بارقام المقاعد لتلصقها ؟