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

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

حتّى لا يضيع الــ Commend Button أو اذا قمت بتحديد نطاق من الخلايا (او حتى خلية واحدة) بعيداً عنه فأنه يتبعك اينما ذهبت بواسطة هذا الكود Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim col%: col = Target.Columns.Count Dim lastcel As Range: Set lastcel = Target.Rows(1).Cells(col) Application.EnableEvents = False With Me.Shapes.Range(Array("SALIM_BTN")) .Left = lastcel.Left + lastcel.Columns.Width + 5 .Top = lastcel.Top .Width = 130 .Height = 28 End With Application.EnableEvents = True End Sub جرب هذا الملف Floting_Btn.xlsm

شاهد هذا الموضوع واذا بحثت ستجد الكثير مساعدة فى ايجاد الارقام الناقصة فى الاستعلام 😅😅😅

أو هذا مثلاً لاختيار اي شيء ( من القائمة في L2 المنسدلة لإخفائه) في حال اضافة بيانات مختلفة عن "تم" او "-" في العامود J يرجى تشغيل الماكرو quelque chose أولاً للحصول على تحديث القائمة المنسدلة Option Explicit Sub Hid_rows() With Application .ScreenUpdating = False .EnableEvents = False End With quelque_chose Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1") With S_sh Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion .Range("m2").Formula = "=$J3<>$L$2" My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2") .Range("M2").ClearContents End With With Application .ScreenUpdating = True .EnableEvents = True End With End Sub '========================================= Sub SHOW_ALL() With Application .ScreenUpdating = False .EnableEvents = False End With On Error Resume Next Sheets("ورقة1").ShowAllData On Error GoTo 0 With Application .ScreenUpdating = True .EnableEvents = True End With End Sub '====================================== Sub quelque_chose() With Sheets("ورقة1") Dim i%: i = 3 Dim arr Dim rg As Object Set rg = CreateObject("system.collections.arraylist") With rg Do Until Range("j" & i) = vbNullString If Not .contains(Range("j" & i).Value) Then .Add Range("J" & i).Value i = i + 1 Loop .Sort arr = .toarray arr = Join(arr, ",") End With With .Range("L2").Validation .Delete .Add xlValidateList, Formula1:=arr End With End With End Sub FILE HERE ايتام دار البر by_CHOOSE_filter.xlsm

وعليكم السلام 🙂 هذه طريقة ادخال البيانات في الاكسل ، وهي ليست صحيحة لقاعدة بيانات !! الطريقة الصحيحة هي شيء من هذا القبيل: وحينها تقدر عمل اي شيء تريد 🙂 جعفر 1024.barna.accdb.zip

زيادة في اثراء الموضوع هذا الكود(اسرع بكثير) Option Explicit Sub Hid_rows() With Application .ScreenUpdating = False End With Dim S_sh As Worksheet: Set S_sh = Sheets("ورقة1") With S_sh .Range("R1") = "تم" Dim My_Table As Range: Set My_Table = .Range("b2").CurrentRegion .Range("m2").Formula = "=$J3<>$R$1" My_Table.AdvancedFilter Action:=1, CriteriaRange:=.Range("M1:M2") .Range("M2").ClearContents .Range("R1").ClearContents End With With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub '========================================= Sub SHOW_ALL() On Error Resume Next Sheets("ورقة1").ShowAllData On Error GoTo 0 End Sub الملف مرفق ايتام دار البر by_adv_filter.xlsm

وعليكم السلام 🙂 اذا كان في حقل الاستعلام شروط كثيرة ، فأنا الجأ الى الوحدة النمطية لتسهيل الامر ، وهذا ما فعلته هنا 🙂 . والنتيجة . والوحدة النمطية: Option Compare Database Option Explicit Public Function Per(Deg As String) As String 'Expr1: IIf([Deg1]="غـ","متخلف",IIf(((Val([Deg1])/20)*100)<50,"Less50",IIf(((Val([Deg1])/20)*100) Between 50 And 55,"50-55%",IIf(((Val([Deg1])/20)*100) Between 55.1 And 60,"55-60%",IIf(((Val([Deg1])/20)*100) Between 60.1 And 65,"60-65%",IIf(((Val([Deg1])/20)*100) Between 65.1 And 70,"65-70%",IIf(((Val([Deg1])/20)*100) Between 70.1 And 75,"70-75%",IIf(((Val([Deg1])/20)*100) Between 75.1 And 80,"75-80%",IIf(((Val([Deg1])/20)*100) Between 80.1 And 85,"80-85%",IIf(((Val([Deg1])/20)*100) Between 85.1 And 90,"85-90%",IIf(((Val([Deg1])/20)*100) Between 90.1 And 95,"90-95%",IIf(((Val([Deg1])/20)*100) Between 95.1 And 99.99,"95-99%","100%")))))))))))) Dim Grade As Double Grade = ((Val(Deg) / 20) * 100) If Deg = "غـ" Then Per = "متخلف" ElseIf Grade < 50 Then Per = "Less50" ElseIf Grade >= 50 And Grade <= 55 Then Per = "50-55%" ElseIf Grade >= 55.1 And Grade <= 60 Then Per = "55-60%" ElseIf Grade >= 60.1 And Grade <= 65 Then Per = "60-65%" ElseIf Grade >= 65.1 And Grade <= 70 Then Per = "65-70%" ElseIf Grade >= 70.1 And Grade <= 75 Then Per = "70-75%" ElseIf Grade >= 75.1 And Grade <= 80 Then Per = "75-80%" ElseIf Grade >= 80.1 And Grade <= 85 Then Per = "80-85%" ElseIf Grade >= 85.1 And Grade <= 90 Then Per = "85-90%" ElseIf Grade >= 90.1 And Grade <= 95 Then Per = "90-95%" ElseIf Grade >= 95.1 And Grade <= 99.99 Then Per = "95-99%" Else Per = "100%" End If End Function جعفر 1022.Problem 55-2003.mdb.zip

تم اضافة سطرين على الكود وهو الان اصبح سريع العقود55-2.xlsm

صحيح سليم حاصيبا تكفي معادلة واحدة شكر لك

استاذ ali mohamed ali بارك الله فيك وهنيئاً لك حب الاخرون الله يبارك لك فيما اعطاك كما اسأل الله ان يجعل اعمالك الصالحة سبب لدخولك اللجنة اللهم امين يارب العالمين

أهلا @محمد احمد لطفى أعتذر عن التأخير.. في مستعرض الصور: اضغط على علامة الزائد لإضافة سجل جديد.. قمت بإجراء بعض التعديلات على النسخة السابقة.. بالنسبة لعناصر HTML وتنسيقتها فقد وضعتها في الجدول CodeSnipping يمكنك إعادة تنسيق العناصر عن طريق الجدول دون الرجوع إلى الشفرة.. أتمنى أن تنال الإضافة إعجابكم.. Photo.zip

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

اتفضل اخى الكريم الملف لعله يفى بالغرض قوائم الفصول.xlsm