عبدالله المجرب

الاستاذ الفاضل حاجي بن عليه حل ولا اروع بالمعادلات === الاخ الفاضل ابو حنين حل ممتاز بالاكواد وفيه ملاحظة ان يتم تعديل هذا السطر من Cells(i + 1, 1).Value = 110000 + m ليكون Cells(i + 1, 1).Value = 220000 + m ويمكن بعد اذنك يمكن اختصار الكود ليكون Private Sub CommandButton1_Click() s = 0: m = 0 For t = 1 To 1000 If Cells(t + 1, 3).Text = "Garmets" Then s = s + 1 Cells(t + 1, 1).Value = 110000 + s Cells(t + 1, 1).Interior.ColorIndex = 3 End If If Cells(t + 1, 3).Text = "Accessories" Then m = m + 1 Cells(t + 1, 1).Value = 220000 + m Cells(t + 1, 1).Interior.ColorIndex = 4 End If Next End Sub

بارك الله فيك اخي ابوحنين

نرجو عدم تكرار المواضيع =========== تم دمج الموضوعين وتنقيح المشاركة

جرب هذا الكود Sub Abu_Ahmed_Trheel() For i = 1 To Sheets.Count For T = 8 To [A1000].End(xlUp).Row If Sheets(i).Name = Cells(T, 1) Then LR = Sheets(i).[B1000].End(xlUp).Row + 1 Sheets(i).Cells(LR, 2) = Cells(T, 1).Offset(0, 1) Sheets(i).Cells(LR, 3) = Cells(T, 1).Offset(0, 2) Sheets(i).Cells(LR, 5) = Cells(T, 1).Offset(0, 3) Sheets(i).Cells(LR, 6) = Cells(T, 1).Offset(0, 4) Sheets(i).Cells(LR, 7) = Cells(T, 1).Offset(0, 5) Sheets(i).Cells(LR, 8) = Cells(T, 1).Offset(0, 6) End If Next Next End Sub

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

ما رايك بهذا الحل =IF(A2>B2;"خطاء";SUMPRODUCT(--(WEEKDAY(ROW(INDIRECT(A2&":"&B2)))<6);--(ISERROR(MATCH(ROW(INDIRECT(A2&":"&B2));H$1:H$7;0)))))

موضوع دسم ومميز ومميز ومميز اتمنى ان تمهلنا لنفهم الموجود فزيادة المعلومات يقلل الاستيعاب

السلام عليكم عمل مميز استاذ رجب وتطبيق رائع للمصفوفات === هذا الكود يقوم بنفس العمل Sub ragab2() T = 2 Range("B8:iv8").ClearContents LC = [iv5].End(xlToLeft).Column For i = LC To 2 Step -1 Cells(8, T) = Cells(5, i) T = T + 1 Next End Sub

شرف لي مرورك ابا ادم

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

يفضل وضع مرفق

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

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

شكرا لكم اخواني والبركة فيكم

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

السلام عليكم عندي برنامج لطلبات الموظفين (حجمه كبير وبه بيانات خاصة*) لم استطع ارفاقه === في البرنامج فورم البيانات وسابفورم بالتفاصيل ومشروطة بان يكون التاريخ هو تاريخ اليوم ليتم عرض الطلب في التقرير الذي سيطبع في الفورم زر طباعة الطلب (تقرير) هذا كود الزر Private Sub Command18_Click() On Error GoTo Err_Command18_Click Dim MyRptName As String MyCriteria = "[الرقم]=" & Me![frmDetailsubform]![الرقم] MyRptName = "rptRequests" DoCmd.OpenReport MyRptName, acNormal, , MyCriteria Exit_Command18_Click: Exit Sub Err_Command18_Click: MsgBox Err.Description Resume Exit_Command18_Click End Sub بهذا الكود كان يتم طباعة الطلب الخاص بالموظف فقط بناء على رقمه اذا كان الطلب مكتوب بتاريخ اليوم الى هنا البرنامج يعمل بشكل جيد جداً وحسب المطلوب لكن بعد متابعتي لموضوع الاستاذ نارت بخصوص اختيار الطابعة الخاصة بالطباعة http://www.officena.net/ib/index.php?showtopic=41998&hl= ولحاجتي لجعل خيار اختيار الطابعة (من مربع تحرير وسرد) قمت بعمل الكود بهذه الطريقة بعد ان اضفت مربع تحرير وسرد يتم عرض فية اسماء الطابعات الموجودة Private Sub Command18_Click() Dim MyRptName As String MyCriteria = "[الرقم]=" & Me![frmDetailsubform]![الرقم] MyRptName = "rptRequests" DoCmd.OpenReport MyRptName, acViewDesign, Null, MyCriteria, acHidden Dim oRpt As Report Set oRpt = Reports(0) oRpt.UseDefaultPrinter = False oRpt.Printer = Application.Printers((Me.cboPrinter)) DoCmd.OpenReport MyRptName, acViewNormal, , MyCriteria DoCmd.Close acReport, MyRptName, acSaveYes Set oRpt = Nothing Exit_Command18_Click: Exit Sub Err_Command18_Click: MsgBox Err.Description Resume Exit_Command18_Click End Sub لكن للاسف فقد ميزة طباعة التقرير بشرط الرقم الوظيفي واصبح يطبع في الطابعة المختارة كل طلبات تاريخ اليوم الحالي فما الحل اخواني الكرام

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

ما شاء الله موضوع رائع ومفيد بارك الله فيك ابا علي

السلام عليكم بداية اهلاً بك بين أخوانك =========== ثانياً الرجاء مستقبلاً الالتزام بقواعد المشاركة قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف ======================= ثالثاً الموضوع غير مفهوم

الحل طويل ومتداخل (انا جربت جملة select case) ويمكن يسبب خلل وتهنيق في الملف

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

لعمل هذا يجب ان يكون عدد صفوف كل ورقة 44 سطر ابتداء من السطر (كشف عن يوم ) والتعديل في الكود بيكون هنا For i = 4 To [A10000].End(xlUp).Row Step 44 بدل عن For i = 4 To 400 Step 44

تم اضافة حل لطلبك الاخير هنا http://www.officena.net/ib/index.php?showtopic=42373

استعمل هذا الكود Sub Abu_Ahmed_Twzee3() R = 1 For i = 1 To [A1000].End(xlUp).Row Cells(i, 1).Resize(1, 5).Copy Sheets("ورقة2").Range("A" & R) R = R + 6 Next End Sub

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