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

أهلا بك @Barna قمت بعمل إجراء بسيط لمعالجة البيانات حسب ما تفضل به الاستاذ جعفر.. أرجو أن تكون صحيحة وخالية من العيوب، وتنال استحسانكم.. 1024.barna.accdb.zip

السلام عليكم تعديل آخر على الملف بإدراج كود بسيط (حسب معرفتي البسيطة بالأكواد) وأرجو أن يفي الغرض المطلوب... الكود وُضع في حدث الورقة "بحث" بحيث بمجرد التغيير في الخلية C1 (رقم السيارة) يجلب بصفة تلقائية كل البيانات الخاصة بهذه السيارة من كل الجداول في شيت "المواقف"... وأرجو أيضا أن يحسّنه (الكود) أحد الإخوة المتمكنين بـ VBA أو يبدله بأحسن وأسرع منه.. ملاحظة: تم إرفاق الملف الخطأ في ردي السابق وأعتذر من الإخوة الذين قاموا بتحميله... قد أعدت إرفاق الملف الصحيح... بن علية حاجي بحث في كل الجداول.xlsm

السلام عليكم ورحمة الله وبركاته الاستعلام يُعتبر العمود الفقري لقواعد البيانات ، وكلما زادت معرفتنا به ، كلما يصبح البرنامج افضل واسرع 🙂 البحث/التصفية في الاستعلام من الطرق المهمة ، ولكن وللأسف الشديد ، ارى الكثير من المبرمجين لا يعرفون الطريقة الصحيحة في عملها ، فالطريقة الغير صحيحة قد تعطيك النتائج ولكن على حساب وقت تنفيذ الاستعلام 😞 الامثله هنا تقوم على انه يوجد لدينا نموذج اسمه frm_Main ، وبه حقل الاسم fName ، وحقل التاريخ:من Date_From ، وحقل التاريخ:الى Date_To ، والحقول في الاستعلام ، حقل الاسم fName ، وحقل التاريخ DateX . 1. اذا اردنا البحث عن اسم كامل (وليس جزء من اسم) ، فيجب ان يكون المعيار في الاستعلام: [forms]![frm_Main]![fName] 2. واذا كان حقل الاسم فارغا في النموذج ، ونريد ان نرى جميع الاسماء ، فالمعيار يصبح: iif(len([forms]![frm_Main]![fName] & '')=0,[fName],[forms]![frm_Main]![fName]) والشرح للتأكد بأن الحقل فارغ في النموذج، بدل ان نكتب IsNull([forms]![frm_Main]![fName]) or [forms]![frm_Main]![fName]=0 فإننا نختصر هذين الشرطين بشرط واحد len([forms]![frm_Main]![fName] & '')=0 iif(كان الحقل فارغ في النموذج,[fName] اعطنا جميع بيانات الحقل,[forms]![frm_Main]![fName]واذا كان الحقل به قيمة فاستعمل هذه القيمة) . 3. اذا اردنا البحث عن جزء من الاسم Like IIf(Len([forms]![frm_Main]![fName] & '')=0,"*","*" & [forms]![frm_Main]![fName] & "*") والشرح IIf(Len([forms]![frm_Main]![fName] & '')=0 نعم Like "*" لا Like "*" & [forms]![frm_Main]![fName] & "*") . 4. اذا اردنا البحث بين تاريخين بدون سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) مع سجلات التاريخ الفارغة Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null والشرح Between (IIf(Len([Forms]![frm_main]![Date_From] & '')=0,#01-Jan-1900#,[Forms]![frm_main]![Date_From])) And (IIf(Len([Forms]![frm_main]![Date_To] & '')=0,#01-Jan-2900#,[Forms]![frm_main]![Date_To])) Or [DateX] Is Null او طريقة استاذنا واخونا العود ابو خليل Between nz([forms]![frm_main]![Date_From];"01/01/1900") And nz([forms]![frm_main]![Date_To];"01/01/2100") . جعفر

حتّى لا يضيع الــ 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

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

متألق دائما

بارك الله فيك استاذ الغالي سليم وزادك الله من علمه دا المطلوب بالظبط شكرا لك

مشاركة مع اخي محمد عملت استعلام حسب فهمي db17.rar

ماشاء الله روعة جزاكم الله خير

جرب هذا الكود Option Explicit Private Sub Worksheet_Activate() data_val1 End Sub '================================== Private Sub ComboBox2_Change() ComboBox1.Clear Dim I% I = 4 With Sheets("العقود") Do Until .Cells(I, "c") = vbNullString If .Cells(I, "c") = ComboBox2.Value Then ComboBox1.AddItem .Cells(I, "d") End If I = I + 1 Loop End With End Sub '==================================== Sub data_val1() Dim I%: I = 4 Dim arr Dim rg As Object Set rg = CreateObject("system.collections.arraylist") With rg Do Until Sheets("العقود").Range("c" & I) = vbNullString If Not .contains(Sheets("العقود").Range("c" & I).Value) Then .Add Sheets("العقود").Range("c" & I).Value I = I + 1 Loop .Sort arr = .toarray End With Sheets("كشف عميل").OLEObjects("Combobox2").Object.List = Application.Transpose(arr) End Sub الملف مرفق AouKoud_22.xlsm

بارك الله فيك استاذنا الغالي وجعلها الله في ميزان حسناتك

أهلا بك @محمد احمد لطفى لم استخدم لغة أخرى! إليك التعديل: Photo.zip

تفضل ، والطريقة اللي تريدها هي رقم 2 في الرابط جعفر

هذه المعادلة المطلوبة =A2&" "&B2

تفضلي ..... test1.accdb

وبارك الله فيكم اخى الحبيب وليد وجزاكم الله خير

مع انك لم ترفع ملفاً للمعاينة اليك هذا الملف كنموذج =IF(N(A1)<=0,"",CHOOSE((0.5-MOD(A1,1)<=0)+1,FLOOR(A1,1),CEILING(A1,1))) takrib.xlsx

وعليكم السلام 🙂 اذا كان في حقل الاستعلام شروط كثيرة ، فأنا الجأ الى الوحدة النمطية لتسهيل الامر ، وهذا ما فعلته هنا 🙂 . والنتيجة . والوحدة النمطية: 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

فورم الصادر والوارد اكسل الفيديو الصور الملف فورم الصادر والوارد اكسل.rar

لم تجب على السؤال! هذا مثال بدون النموذج الفرعي Photo.zip

أهلا بك محمد.. لكون أكسس لا يدعم الاستنساخ أثناء التشغيل فلابد من الإعتماد على مكونات ActiveX التي يوفرها أكسس... أحد هذه المكونات هو المكون Microsoft.Form.Frame يوفر هذا المكون سطح بيني(طبقة) قابل للاستنساخ؛ بين النموذج والمكونات الأخرى التابعة ل Microsoft.Form هذا مثال بسيط لطريقة إدراج الصور أثناء التشغيل حسب المفهوم السابق Photo.zip

زيادة في تقديم الأفضل هذا الكود Option Explicit Sub Give_ma7soul_new() Application.ScreenUpdating = False Dim sh1 As Worksheet: Set sh1 = Sheets("تجهيز (2)") Dim sh2 As Worksheet: Set sh2 = Sheets("ورقة2") Dim lr1: lr1 = sh1.Cells(Rows.Count, 2).End(3).Row Dim lr2: lr2 = sh2.Cells(Rows.Count, 2).End(3).Row If lr2 < 7 Then lr2 = 7 Dim My_rg As Range, i% Dim x%, y%, z% Dim k%: k = 3 Dim st$: st = sh2.Range("c3") Dim m%: m = 7: Dim col%: col = 3 Dim Matc% Dim s1#, s2#, s3 Dim My_col% Dim part_sum1#, part_sum2#, part_sum3# Dim Newlr% Dim row_last_sum% '================== Dim ar() Dim xx%: xx = 1 For i = 30 To 600 Step 30 ReDim Preserve ar(1 To xx): ar(xx) = i xx = xx + 1 Next '================== sh2.Range("b7:F" & lr2 + 2).ClearContents On Error Resume Next My_col = sh1.Rows(7).Find(st).Column On Error GoTo 0 If My_col = 0 Then GoTo 1 Set My_rg = sh1.Cells(9, My_col).Resize(lr1, 3) For i = 9 To lr1 x = (My_rg.Cells(i - 8, 1) <> 0) y = (My_rg.Cells(i - 8, 2) <> 0) z = (My_rg.Cells(i - 8, 3) <> 0) If x + y + z = 0 Then GoTo next_i sh2.Cells(m, k) = sh1.Cells(i, 2) sh2.Cells(m, col + 1).Resize(, 3).Value = _ My_rg.Cells(i - 8, 1).Resize(, 3).Value s1 = s1 + sh2.Cells(m, col + 1) s2 = s2 + sh2.Cells(m, col + 2) s3 = s3 + sh2.Cells(m, col + 3) sh2.Cells(m, col - 1) = sh1.Cells(i, 1) m = m + 1 On Error Resume Next Matc = Application.Index(ar, Application.Match(m, ar, 0)) If Matc <> 0 Then m = Matc + 2 Matc = 0 With sh2.Cells(m - 2, col) .Value = "Sum Of This Page" .Offset(1, 0) = " Sum Of Previous" .Offset(0, 1) = s1 .Offset(0, 2) = s2 .Offset(0, 3) = s3 part_sum1 = part_sum1 + s1: s1 = 0 part_sum2 = part_sum2 + s2: s2 = 0 part_sum3 = part_sum3 + s3: s3 = 0 .Offset(1, 1) = part_sum1 .Offset(1, 2) = part_sum2 .Offset(1, 3) = part_sum3 End With End If On Error GoTo 0 next_i: Next '====================================== Newlr = sh2.Cells(Rows.Count, 3).End(3).Row + 1 row_last_sum = sh2.Range("C:C").Find(what:="Sum Of Previous", _ after:=sh2.Range("c1"), searchdirection:=xlPrevious).Row sh2.Cells(Newlr, 3) = "Sum Of This Page" sh2.Cells(Newlr + 1, 3) = "Total Sum" sh2.Cells(Newlr, 4).Formula = _ "=SUM(D" & row_last_sum + 1 & ":D" & Newlr - 1 & ")" sh2.Cells(Newlr, 5).Formula = _ "=SUM(E" & row_last_sum + 1 & ":E" & Newlr - 1 & ")" sh2.Cells(Newlr, 6).Formula = _ "=SUM(F" & row_last_sum + 1 & ":F" & Newlr - 1 & ")" sh2.Cells(Newlr + 1, 4) = Cells(row_last_sum, 4) + Cells(Newlr, 4) sh2.Cells(Newlr + 1, 5) = Cells(row_last_sum, 5) + Cells(Newlr, 5) sh2.Cells(Newlr + 1, 6) = Cells(row_last_sum, 6) + Cells(Newlr, 6) sh2.Cells(Newlr, 4).Resize(2, 3).Value = _ sh2.Cells(Newlr, 4).Resize(2, 3).Value '----------------------------- ActiveSheet.ResetAllPageBreaks Newlr = sh2.Cells(Rows.Count, 3).End(3).Row sh2.PageSetup.PrintArea = sh2.Range("b1:f" & Newlr).Address For i = 30 To Newlr Step 30 ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=Cells(i + 2, 1) Next 1: Erase ar Application.ScreenUpdating = True End Sub الملف مرفق Salim_up_Advanced.xlsm

أحسنت عمل ممتاز استاذ سليم جعله الله فى ميزان حسناتك

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

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

لم أعد أجرؤ أن أرفع بدون ملف الشرح لكن رابط تحميل ملف الشرح أسفل الفيديو مباشرة فى الوصف وفقك الله أخى شيفان الرابط المباشر لتحميل ملف الشرح https://drive.google.com/open?id=0Bw4O7dVd4FBfaF9KeVZydTE4T2s