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

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

وعليكم السلام ورحمة الله وبركاته ضف هذا السطر للكود wsSource.Cells(i, 1).Resize(1, 14).ClearContents الكود كاملا Sub test() Dim wsSource As Worksheet Dim wsPass As Worksheet Dim lastRow As Long Dim i As Long Dim passRow As Long Dim passCount As Long Dim failRow As Long Dim wsFail As Worksheet Set wsSource = ThisWorkbook.Sheets("Sheet1") Set wsPass = ThisWorkbook.Sheets("Sheet2") lastRow = wsSource.Cells(wsSource.Rows.Count, "a").End(xlUp).Row passRow = 4 For i = 3 To lastRow If InStr(1, LCase(wsSource.Cells(i, "g").Value), "1/6") > 0 Then wsPass.Cells(passRow, 1).Resize(1, 14).Value = wsSource.Cells(i, 1).Resize(1, 14).Value wsPass.Cells(passRow, 1).Value = passRow - 3 wsPass.Cells(passRow, 1).NumberFormat = wsSource.Cells(i, 1).NumberFormat ' نسخ التنسيق wsSource.Cells(i, 1).Resize(1, 14).ClearContents passRow = passRow + 2 End If Next i End Sub

ولكن لاحظ اخي @كريمو2 ان المستخدم هو من يقوم بكتابة الاسم .... فلو اخطأ في مسافة او حرف الكمبيوتر ذكي لدرجة الغباء ... يعني يقبلها دون تردد .... فلعلاج ذلك المفترض يتم اختيار الاسم من خلال قائمة منسدلة وليس تسجيل المستخدم ,,, اليس كذلك ؟؟؟؟؟؟

نعم لاحظته ووجدت المشكل كما أشرت بالصورة فعلا هذا هو المطلوب استاذ نافل بالاسم

وعليكم السلام ورحمة الله تعالى وبركاته لتحديد حجم كل منتج مع لونه يمكنك استخدام الصيغة التالية =SUMPRODUCT(($B$2:$B$8=$B11)*($C$2:$C$8=C$10)*($D$2:$J$8)) مع سحبها يسارا والى للاسفل على حسب احتياجاتك مجرد اقتراح يمكنك أيضا استخراج مجموع كل آلة بشكل منفصل حسب اختيارك للحصول على مزيد من التفاصيل وعند اختيار الخيار "الكل" سيتم عرض مجموع جميع الآلات يمكن القيام بذلك باستخدام الصيغة التالية بعد إضافة قائمة منسدلة تحتوي على أسماء رؤوس الأعمدة الموجودة في الجدول =IF($O$10="الكل", SUMPRODUCT(($B$2:$B$8=$M12)*($C$2:$C$8=N$11)*($D$2:$J$8)), IFERROR(SUMIFS(INDEX($D$2:$J$8, 0, MATCH($O$10, $D$1:$J$1, 0)), $B$2:$B$8, $M12, $C$2:$C$8, N$11), 0)) هدا سيمكنك من استخراج النتائج بعدة طرق يمكنك اختيار ما يناسبك زيرو 2.xlsx

السلام عليكم حفظ الصورة + غرض البيانات الخطوات زر تفريغ البيانات تعبئة البيانات ورقم القيد اجباري زر اظافة ومدمج معه تحميل الصورة ويمكن تحميل الصورة من اي ملف على جهاز الكمبيوتر عرض البيانات - البحث بالقيد او بالاسم مع استدعاء الصورة انتهي الملف المنظومة11.xlsm

بسيطة يا صديقي .. تستطيع ذلك بعدة طرق ، منها :- اولاً تعريف متغير عام في أي وحدة نمطية أو وحدة نمطية جديدة ، كما تريد Public SelectedGrades As String ثم ، تعديل الكود السابق ليصبح ما يلي :- Dim varItem As Variant Dim strCriteria As String Dim strFilter As String Dim strSelectedGrades As String If Me.lst_XX_100.ItemsSelected.Count = 0 Then MsgBox "يرجى اختيار عنصر واحد على الأقل من الليست بوكس.", vbExclamation, "تنبيه" Exit Sub End If For Each varItem In Me.lst_XX_100.ItemsSelected If Len(strCriteria) > 0 Then strCriteria = strCriteria & " OR " End If strCriteria = strCriteria & "(grade = '" & Me.lst_XX_100.Column(0, varItem) & "' AND " & _ "groupe = '" & Me.lst_XX_100.Column(1, varItem) & "')" If Len(strSelectedGrades) > 0 Then strSelectedGrades = strSelectedGrades & " - " End If strSelectedGrades = strSelectedGrades & Me.lst_XX_100.Column(0, varItem) Next varItem SelectedGrades = strSelectedGrades strFilter = "annee = '" & Me.ANNEE200 & "' AND (" & strCriteria & ")" DoCmd.OpenReport "rap_list", acViewPreview, , strFilter الآن في التقرير في حدث عند التحميل ، وعلى افتراض ان لديك مربع نص (TX_LBL) ؛ نضع الجملة التالية Me.Tx_Lbl.Value = SelectedGrades ولضمان تفريغ قيمة المتغير عند اغلاق التقرير ، ضع في الحدث عند الاغلاق للتقرير ، الكود التالي SelectedGrades = "" وملفك بعد التعديل ، ويضم الحل السابق وهذا الحل . base_m.accdb

اشكرك اخي @ناقل على الاسئلة التي شرحت لنا ما يريده اخانا @كريمو2 هل هذا التصور المطلوب ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

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

طيب ماذا لو كان المبلغ أقل هل يحق له المنحة مرة أخرى في خلال سنتين .... يعنى لو استحق في المرة الأولى وكان المبلغ 2000 دينار وطلب منحة اخرى لعمل أيضا نظارة بمبلغ 5000 دينار هل يستحق ام لمرة واحدة فقط دون اعتبار مجموع المبالغ ب 7000 دينار

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

السلام عليكم بعد اذن الاستاذ عبد الرحيم محاولة عسى ان يكون فيها طلبك الاول وهو حفظ الصورة كود الاظافة وتحميل نم اظافة المطالبة بادخال رقم القيد خطوات العمل تفريغ المحتوبات كنابة رقم القيد نحميل الصورة الاظافة الطلب الثاني متشعب ومرتبط ب sheet4 والذي لا نعلم ما علاقتة بالامر تحياتي حفظ الصورة.xlsm

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

الموضوع بسيط جدا .. في حدث عند الإغلاق لنماذج الإدخال أو عند زر الرجوع للشاشة الرئيسية ضع هذا الكود وغير أسماء مربعات النص التي بها عدادات الأرقام : On Error Resume Next [Forms]![frm_basic]![TxtBox1].Requery ' تحديث العداد الأول [Forms]![frm_basic]![TxtBox2].Requery ' تحديث العداد الثاني [Forms]![frm_basic]![TxtBox3].Requery ' تحديث العداد الثالث

وعليكم السلام ورحمة الله تعالى وبركاته يمكنك استخدام الكود التالي من المصنف الرئيسي وتحديث ملفات الإدارة دفعة واحدة بدون فتحها او تغيير تنسيقها يكفي وضعها في نفس مسار المصنف بحيث يتم تحديث البيانات عند التحقق من عدم وجود الرقم التأميني مسبقا على ملف الإدارة الهدف وتحديث عمود (م) وإظافة تاريخ التحديث في عمود ( تاريخ دخول القسم) Option Explicit Sub Departments_update() Dim WB As Workbook, destWB As Workbook, srcWS As Worksheet, destWS As Worksheet, _ iRow As Long, Rng As Range, dstRng As Long, lastRow As Long, Cnt As String, _ tmp As String, n As String, WSname As String, ShArr As Variant, j As Boolean, _ Updated As Boolean, nameFile As String, cell As Range, result As Boolean ShArr = Array("المستحقين", "احياء", "التفتيش", "اخرى") Cnt = "=SUBTOTAL(103,INDIRECT(ADDRESS(ROW(),COLUMN()+1)&"" :""&ADDRESS(ROW($E$7),COLUMN()+1)))" Updated = False result = False Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual Application.EnableEvents = False: Application.DisplayAlerts = False Set WB = ThisWorkbook For Each srcWS In WB.Worksheets If Not IsError(Application.Match(srcWS.Name, ShArr, 0)) Then WSname = srcWS.Name nameFile = WB.Path & "\" & WSname & ".xls" If Dir(nameFile) <> "" Then result = True Set destWB = Workbooks.Open(nameFile) Set destWS = destWB.Worksheets(WSname) If Not destWS Is Nothing Then For iRow = 7 To srcWS.Cells(srcWS.Rows.Count, "R").End(xlUp).Row n = srcWS.Cells(iRow, "R").Value If InStr(1, n, WSname, vbTextCompare) > 0 And n <> "" Then tmp = srcWS.Cells(iRow, "E").Value j = False lastRow = destWS.Cells(destWS.Rows.Count, "E").End(xlUp).Row For Each cell In destWS.Range("E7:E" & lastRow) If cell.Value = tmp Then j = True Exit For End If Next cell If Not j Then Set Rng = srcWS.Range(srcWS.Cells(iRow, 3), srcWS.Cells(iRow, 27)) dstRng = destWS.Cells(destWS.Rows.Count, "E").End(xlUp).Row + 1 If dstRng < 7 Then dstRng = 7 destWS.Cells(dstRng, "C").Resize(, 25).Value = Rng.Value destWS.Cells(dstRng, "D").Value = Date destWS.Cells(dstRng, "B").Formula = Cnt Updated = True End If End If Next iRow destWB.Close SaveChanges:=True Else destWB.Close SaveChanges:=False End If Set destWB = Nothing Set destWS = Nothing End If End If Next srcWS If result Then MsgBox IIf(Updated, "تم تحديث البيانات بنجاح", "جميع البيانات محدثة مسبقا"), vbInformation, "تعليمات" Else MsgBox "لم يتم العثور على أي ملفات خاصة بالإدارات", vbExclamation, "تنبيه" End If Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True: Application.DisplayAlerts = True Set WB = Nothing: Set srcWS = Nothing: Set Rng = Nothing: Set cell = Nothing End Sub ملفات الإدارة.rar ترحيل الصفوف مع عدم التكرار.rar

وعليكم السلام ورحمة الله وبركانه قم بفتح ملف احياء وشغل الكود ولا تفتح الملف الرئيسي الكود يقوم بفتحه واغلاقه اثناء تنفيذ الكود نفس الكود يطبق على الادارات الاخرى عند حفظ الملف احقظه xslb او xlsm لان الملف به كود مراعاة اسماء الصفحات موحدة بمعنى في الملف الرئيسي احياء يكون في ملف احياء اسم الشيت نفس الاسم الملف الرئيسي.xlsb احياء.xlsb

وعليكم السلام ورحمة الله وبركاته 🙂 عملت شيء مشابه لهذا سابقا .. فقط يمكن تعديله ليتوافق مع الحاجة 🙂 ‏‏Meter -Moosak _ Final.accdb

السلام عليكم إخواني الأحباب في المنتدى الرائع أقدم لكم درس بسيط عن الحلقة التكرارية For... Next لأهمية استخدام مثل هذه الحقات في التعامل مع الأكواد .. أرجو أن ينفع الله به المسلمين FOR...NEXT LOOP.rar