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

جرب هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$C$5" And Target.Count = 1 Then get_10_studiants End If Application.EnableEvents = True End Sub '========================= Sub get_10_studiants() Application.ScreenUpdating = False Dim A As Worksheet, F As Worksheet Dim find_rg As Range Dim my_clas$ Dim Obj As Object Dim x%, LF%, Ro%, first%, last%, i% Dim arr(9) Set A = Sheets("ALL_STD") Set F = Sheets("first") my_clas = F.Range("C5") LF = F.Cells(Rows.Count, "b").End(3).Row If LF < 8 Then LF = 8 F.Range("A8:C" & LF).ClearContents Ro = A.Cells(Rows.Count, 1).End(3).Row Set Obj = CreateObject("System.collections.arraylist") Set find_rg = A.Range("a:a").Find(my_clas, lookat:=1) If Not find_rg Is Nothing Then first = find_rg.Row: last = first Do Obj.Add A.Range("AF" & last).Value Set find_rg = A.Range("a:a").FindNext(find_rg) last = find_rg.Row If last = first Then Exit Do Loop End If Obj.Sort: Obj.Reverse For i = 0 To 9 F.Range("A8").Offset(i) = i + 1 arr(i) = Obj(i) Next F.Range("c8").Resize(i) = Application.Transpose(arr) F.Range("B8").Resize(i).Formula = _ "=IFERROR(INDEX(ALL_STD!$B$8:$B$706,MATCH(C8,ALL_STD!$AF$8:$AF$706,0)),"""")" F.Range("a7").CurrentRegion.Value = _ F.Range("a7").CurrentRegion.Value End Sub الملف مرفق First_10.xlsm

تفضل UserformKeyboard.xls

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

DoCmd.OutputTo acOutputReport, "Attendance Sheets", acFormatPDF, , False

وعليكم السلام ضع الكود التالى تحت الكود السابق مباشره Dim RS As DAO.Recordset Dim Counter As Integer Set RS = Me.Recordset If RS.RecordCount = 0 Then Exit Sub End If RS.MoveFirst Counter = 0 While Not RS.EOF Counter = Counter + 1 RS.Edit RS!Idd3 = Counter RS.Update RS.MoveNext Wend بالتوفيق ان شاء الله

أستاذ اشرف السيد يوسف أين الضغط على الإعجاب ؟!!💙

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

نعم ممكن 1استعلام لعدم التكرار1.mdb

جرب هذا الكود Option Explicit Sub test_me() Dim Sh As Worksheet, D As Worksheet Dim first#, last#, i#, Ro# Dim my_rg As Range, find_rg As Range Dim adres#, Obj As Object Set Sh = Sheets("Sheet1"): Set D = Sheets("DATA") Set Obj = CreateObject("System.collections.arraylist") Ro = Sh.Cells(Rows.Count, 1).End(3).Row adres = [TELE].Offset(, -1).Find("").Row Set my_rg = D.Range("B2").Resize(adres - 2) For i = 5 To Ro Set find_rg = my_rg.Find(Sh.Range("A" & i).Value, lookat:=1) If Not find_rg Is Nothing Then first = find_rg.Row: last = first Do Obj.Add D.Range("C" & last).Value Set find_rg = my_rg.FindNext(find_rg) last = find_rg.Row If last = first Then Exit Do Loop End If ' Obj.Sort Sh.Range("C" & i) = Obj(Obj.Count - 1) Obj.Clear Next End Sub الملف مرفق Abu_Alaa.xlsm

مجرد ما تقف عالصف هيعيد ترقيمه لحاله جرب

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم test1.rar تحياتي ولمعرفة ما تم تعديله تم اضافة استعلام الحاق Query1 تم اضافة حقل في جدول اجمالي الاجرائات باسم معرف_الاجراء تم اضافة استعلام تحديث Query1 تم اضافة حدث للقائمة عند النقر المزدوج للانتقال الى السجل المطلوب تحياتي

بعد إذن أستاذنا الفاضل سليم لحماية المعادلات من العبث ممكن تضع هذا الكود في حدث ورقة العمل لمنع المستخدم من الوقوف على الخلية التي بها معادلة وبدون رقم سري جرب هذا Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select End If End Sub My_students (1).xlsm

السلام عليكم بعد إذن الأستاذ خالد في المرفق طريقتان باستخدام فانكشن في حال أردت عمل ما ترغب في الجدول مباشرة فلن تستفيد من الوحدة وسنقوم بعمل المعادلة المطلوبة. مبدئياً انظر المرفق وأعلمنا بالنتيجة Minimum.rar

كل الشكر استاذ سليم .... كالعادة قمة الدعم والمساعدة

بالخدمة اخي العزيز وتفضل التعديل test-Ok1.rar

جزاك الله خيرا اخى واستاذى خالد @kha9009lid وتسلم ايدك عالمعايير الجميله واخى خالد @خالد سيسكو جزاك الله خيرا ومتابعتك ايانا بارك الله فيك وضحنا لك بس انه لا يوجد تكرار وانت ادرى بشغلك استاذ عماد وكما ترى بفضل الله ثم اخواننا واساتذتنا كل شىء سهل وبسيط وممتع ايضا بالتوفيق ان شاء الله

وعليكم السلام روحمة الله وبركاته أخي الكريم أولا قوانين وأنظمة المنتدى تمنع كسر حماية الملفات احتراما لحقوق المبرمج ثانيا البرنامج لم تتم برمجته بواسطة الاكسس فقد تم برمجته بواسطة احد تطبيقات visual stuio وتم استخدام قاعدة بيانات اكسس لتخزين البيانات اما بخصوص ملف الاكسل فأعتقد انه تم ربطه بقاعدة بيانات الاكسس لاستعراض البيانات ::بالتوفيق::

السلام عليكم اخي العزيز يمكنك عمل ذلك عن طريق الجدول وكذلك عن طريق الاستعلام حسب مافهمت من سؤالك تحياتي data.rar

استعلام الحذف لطفا شاهد الفيديو رابط تحميل ملف العمل في صندوق وصف الفيديو

أحسنت استاذ عبد اللطيف .. عمل ممتاز بارك الله فيك

عليكم السلام اخى الكريم جرب هذا الموقع لاختصار الرابط حتى يقبلة الاكسل https://tinyurl.com/

أ.مازن الحسيني مش عارف ان كنت فهمت صح ام لا .. جرب المرفق عسى أن يكون المطلوب نهائي الصادر والوارد.accdb

تفضل هذه المعادلة Option Explicit Option Compare Text Function kh_count_y_m_d(Mydate_Birth As Date, Optional Mydate_Now _ , Optional Y_M_D As String = "Y_M_D", Optional MyCalendar As Boolean) Dim Mydate As Date, KH_Calendar As Integer Dim D_1 As Integer, D_2 As Integer, M_1 As Integer, M_2 As Integer, Y_1 As Integer _ , Y_2 As Integer, D As Integer, M As Integer, Y As Integer If IsDate(Mydate_Now) Then Mydate = Mydate_Now Else Mydate = Date If IsDate(Mydate_Birth) And CDate(Mydate_Birth) <= CDate(Mydate) Then KH_Calendar = Calendar If MyCalendar = True Then Calendar = 1 Else Calendar = 0 D_1 = Day(Mydate): D_2 = Day(Mydate_Birth) M_1 = Month(Mydate): M_2 = Month(Mydate_Birth) Y_1 = Year(Mydate): Y_2 = Year(Mydate_Birth) If D_1 >= D_2 Then D = D_1 - D_2: M = 0 Else D = D_1 + 30 - D_2: M = -1 If M_1 + M >= M_2 Then M = M_1 + M - M_2: Y = 0 Else M = M_1 + M + 12 - M_2: Y = -1 Y = Y_1 + Y - Y_2 If Y_M_D <> "Y" Or Y_M_D <> "M" Or Y_M_D <> "D" Then kh_count_y_m_d = Y & "y-" & M & "m-" & D & "d" If Y_M_D = "Y" Then kh_count_y_m_d = Y If Y_M_D = "M" Then kh_count_y_m_d = M If Y_M_D = "D" Then kh_count_y_m_d = D Calendar = KH_Calendar End If End Function kh_count.xlsm

السلام عليكم ارجو السماح لي بالمشاركة واترخص من الاستاذ محمد ابو عبد الله test-Ok.rar

هو ليس مكرر استاذ عماد بناء على باقى السجل وليس كجزء من السجل باقى السجل فى الثلاث سجلات مختلف فلذلك ظهر معك ثلاث مرات بالتوفيق

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

كيف يمكن تعبئة جدول مرتيب ابجديا فقط من خلال الكتابة في الصف رقم 2 للمزيد انظر الى هذا الملف WRITE_JUST IN ROW_2.xlsm

اسهل حل عملته لك وهو كما اشار اخى واستاذى @kha9009lid بالرابط السابق بعمل المفتاح الاساسى على جميع الحقول وتم الحاق السجلات هل هذا ما تريد ام شىء آخر تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق New folder.rar

وعليكم السلام ان من اصعب مراحل المشروع هى تحليل وربط العلاقات لتنتج قاعده بيانات سليمه الحل من وجهه نظرى البسيطه كطالب علم هو اضافه حقل فى جدول المخابره لتتم فيم عمليه العد من رقم 1 بمعنى رقم المخابره مفتاح اساسى فريد ليتم ربط مع جدول الكتب كما بالمثال السابق ويتم اضافه حقل كمسلسل ويقبل التكرار حتى اننى حاولت إستخدام جدول التقاطع ولم يظبط معى انظر للمرفق بعد اضافه الحقل ولكن دعنى استوضح شىء منك اخى مازن اليس من المفروض لكل اضباره كتاب والكتاب به عده مخبرات او امخابره بمعنى اضباره تكليفات كتاب رقم رقم 500 مثلا بها تكليف للسيد مازن مثلا كتاب رقم رقم 550 مثلا بها تكليف للساده مازن واحمد ومحمد مثلا وان شاء الله احد اخواننا واساتذتنا يعاونوننا وارد وصادر(1).accdb

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

بارك الله فيك استاذ حسين وبعد اذن حضرتك ولإثراء الموضوع ,يمكنك ايضا استخدام هذا الكود فى حدث الصفحة Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("c4")) Is Nothing Then For Each opb In ActiveSheet.OptionButtons If opb.Caption = [C4].Value Then opb.Value = 1 opb.Interior.Color = RGB(255, 204, 153) Else If opb.Caption <> [C4].Value Then opb.Interior.Color = xlNone End If Next opb End If End Sub ربط القائمة المنسدلة مع زر الاوبشن.xlsm

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

السلام عليكم قمت بتصميم برنامج لصديق لي لبيع وشراء الاجهزة الخلوية - مع فكرة الباركود حسب ما طلب مني البرنامج جاهز وهو مقدم لكم هدية لعلكم تستفيدون منه جربوه واعطوني رأيكم فيه ** لا يشكر الله من لا يشكر الناس كل الشكر للصديق المهندس هاني مجدي ( من الشقيقة مصر ) حيث هو صاحب الفكرة واستفدت منه الكثير مؤسسة البركة لبيع الخلويات.rar

السلام عليكم المثال الاول اللي عملته لك كان بشرطين معا ( الاسم والعمر) انظر اخي للمرفق استعلامات بشرط واحد فقط بين الجدولين A- استعلام للاسماء المتشابهه (المكررة). B- استعلام للارقام المتشابهة (المكررة). اتمنى يكون المطلوب التكرار-2.rar

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

تفضل اخى الكريم هل هذا هو طلبك mared.rar

السلام عليكم ورحمة الله وبركاته أعزائي اعضاء منتداي العزيز والمفضل سؤالي يا اخوان انا عندي قاعدة بيانات كبيرة جداً على ورقة اكسل وبعض الاحيان اريد ان اكتب خطابات تكريم او شكر لبعض العاملين وذلك على صفحة وورد والمطلوب اريد اي طريقة تجعلني اكتب الرقم الوضيفي يدوياً للشخص المراد تكريمه على صفحة word ويتم ظهور اسمه ووضيفته وما اريد ان اضيفه بالخطاب تلقائياً طبعاً يسحب المعومات من ورقة الاكسل تلقائياً ملاحظة ( انا كتبت السؤال في قسم word ولكن لم اجد جواب / فتوقعت ان سؤالي في المكان الخطا لذلك نقلته هنا اشكركم ربط.rar