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

ما علينا من الاربع الخانات هلا وضعت تصور للمطلوب(يعني تضع المدخل والمخرج) ضع مثال للمدخلات وكيف سيكون الناتج وان شاء الله ستجد الحل

اخي ما هو المطلوب بالضبط يعني حدد ايش عمل كل زر من ازرار الفوم

بصراحة لم افهم المطلوب لكن جرب المرفق Bo22ok1.rar

المطلوب غير واضح

اخي اولاً اهلاً بك بيننا ثانياً نرجو الالتزام بقواعد المشاركة (العنوان مخاف + لم تقم بوضع شرح مبسط للمطلوب) بخصوص ارفاق ملف قم بضغط الملف ببرنامج وينرار او وينزيب ثم قم برفعه

**** إن شاء الله سيتم اصدار النشرة بشكل شهري بدل من نصف شهري (يتخللها عدد من الاعداد الخاصة عن الرواد حسب التفرغ)**** النشرة الدورية العدد الثاني عشر رابط العدد من هنا * سيتم توزيع الوصلة بالبريدعلى جميع الاعضاء من قبل الاستاذ محمد طاهر. *ستصدر النشرة دوريا بصورة نصف شهرية بإذن الله تعالى وسيكون هناك أعداد خاصة لبعض أعمال رواد منتدى أوفيسنا. مرفق الملف فى صيغة Pdf news 12.pdf

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

اخي سك بابك ==== جرب هذا الكود Sub Excel4Us_Main() 'Yahya Hussien Dim FName As String, wbs As Workbook, FileName As String, ArrFile() As Variant, i As Integer, cl As Range Dim Mainwb As Workbook, NewWb As Workbook Set Mainwb = ActiveWorkbook FName = ActiveWorkbook.Path FileName = Dir(FName & "\*.xls*") Do Until FileName = "" i = i + 1 ReDim Preserve ArrFile(1 To i) ArrFile(i) = FileName FileName = Dir Loop For i = LBound(ArrFile) To UBound(ArrFile) If ArrFile(i) <> Mainwb.Name Then Workbooks.Open FName & "\" & ArrFile(i) Set NewWb = ActiveWorkbook NewWb.Sheets("التقدير").Range("A2:D1000").ClearContents For Each cl In Mainwb.Sheets("Class 1").Range("G3:G10") If cl.Value = NewWb.Sheets("التقدير").Range("J1") Then LR = NewWb.Sheets("التقدير").Range("A" & Rows.Count).End(xlUp).Row + 1 NewWb.Sheets("التقدير").Range("A" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 1).Value NewWb.Sheets("التقدير").Range("B" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 6).Value NewWb.Sheets("التقدير").Range("C" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 7).Value NewWb.Sheets("التقدير").Range("D" & LR).Value = Mainwb.Sheets("Class 1").Cells(cl.Row, 8).Value End If Next '************************************************************************************************ For Each cl In Mainwb.Sheets("Class 2").Range("G3:G10") If cl.Value = NewWb.Sheets("التقدير").Range("J1") Then LR = NewWb.Sheets("التقدير").Range("A" & Rows.Count).End(xlUp).Row + 1 NewWb.Sheets("التقدير").Range("A" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 1).Value NewWb.Sheets("التقدير").Range("B" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 6).Value NewWb.Sheets("التقدير").Range("C" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 7).Value NewWb.Sheets("التقدير").Range("D" & LR).Value = Mainwb.Sheets("Class 2").Cells(cl.Row, 8).Value End If Next NewWb.Save NewWb.Close False End If 1 Next i End Sub ضعه في موديول وضع هذا في حدث ThisWorkeBook Private Sub Workbook_BeforeClose(Cancel As Boolean) Call Excel4Us_Main End Sub

السلام عليكم الاستاذان الفاضلان احمد زمان ابونصار شكراً لكما

السلام عليكم انا استعملت هذا الكود Sub Macro1() Rows("2000:65536").EntireRow.Hidden = False End Sub

مبروك اخي ابو اليسر وان شاء الله منها للاعلى

تفضل المرفق arab7th.rar

شكرا لك أخي Bluemind : مثال جميل وجهد طيب

اخواني الكرام الجزء الاول من الفصل الخامس الملف الذ شرحت عليه في المرفقات الشرح 5 .rar

{وَبَشِّرِ الصَّابِرِينَ الَّذِينَ إِذَا أَصَابَتْهُمْ مُصِيبَةٌ قَالُوا إِنَّا لِلَّهِ وَإِنَّا إِلَيْهِ رَاجِعُونَ أُولَئِكَ عَلَيْهِمْ صَلَوَاتٌ مِنْ رَبِّهِمْ وَرَحْمَةٌ وَأُولَئِكَ هُمُ الْمُهْتَدُونَ} [البقرة: 155-157]. رحم الله ميتكم اللهم طيب ثراه و اكرم مثواه واجعل الجنة مستقره و مأواه

السلام عليكم تم فصل الموضوع للفائدة ================== اخي الفاضل يمكنك الاستفادة من هذا الرابط ففيه موضوع مشابه لما تطلبه http://www.officena.net/ib/index.php?showtopic=38530

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

بارك الله فيك استاذ محمد تم الاستعان بهذه الترجمة وان شاء الله اني وفقت في هذا الموضوع http://www.officena.net/ib/index.php?showtopic=40026

بما ان اللغة فرنسية هلا جربت هذه المعادلة (تم الاستعانة بملف للاستاذ يحياوي لترجمة الدوال) =si(ou(A1="مدير";A1="ناظر");0;500)

قمت بتحديد العمود E ثم قمت بعملية استبدال (Ctrl + F ) وضعت في خانة البحث عن " وتركت خانة استبدال ب فارغة ثم اضغط استبدال الكل

اخي الفاضل سجل مايكرو بالعملية وستحصل على كود للفرز

اذاً شاهد المرفق دالة اف عبدالله المجرب.rar

هذا المرفق بعد ازالة " وتنفيذ الكود ابواحمد.rar

اخي الفاضل المشكلة انك واضع الارقام هكذا "09:00" ويفترض ان تكون هكذا 09:00

اخي هلا ارفقت ملف اكسل