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

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

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

السلام عليكم اخي سعد تفضل المرفق بعد التعديل عليه Sub OFFICNA() Set a = Sheets("الترحيل") Set b = Sheets("المرتبات") LR = b.Range("b" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False For Each cl In b.Range("B4:B" & LR) If a.Range("C8").Value = cl.Value Then b.Select cl.Select Cells(cl.Row, 3).Value = a.Range("C9") Cells(cl.Row, 4).Value = a.Range("C10") Cells(cl.Row, 5).Value = a.Range("C11") Cells(cl.Row, 6).Value = a.Range("C12") Cells(cl.Row, 8).Value = a.Range("E7") Cells(cl.Row, 10).Value = a.Range("E8") Cells(cl.Row, 12).Value = a.Range("E9") Cells(cl.Row, 14).Value = a.Range("E10") Cells(cl.Row, 15).Value = a.Range("E11") Cells(cl.Row, 16).Value = a.Range("E12") End If Next cl End Sub عبدالله المجرب.rar

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

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

السلام عليكم اخي ابوشرف تم عمل اللازم المشكلة كانت في تسلسلات بعض TextBox مما سبب خلل في دالة VLookup احمد محاسبة 3.rar

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

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

اخي ومعلمي جمال دغيدي مرورك شرف لي فشكراً لك اخي احمد شكراً جزيلاً لك.

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

اخي سأكون مضطراً لابقاء الملف مغلقاً لمدة اسبوع ثم الاحظ ان حدث تغيير فهناك خلل (وانا اعتقد بان الملف المرفق لن يكون به خلل ما دام الخليه غير مرتبطة بمعادلة او كود ) وان لم يحدث تغيير فالخلل عندك في الاكسل سؤال هل جربت ان تقوم بعمل ملف تجريبي وتضع به تواريخ وتلاحظ النتيجة بعد اسبوع؟؟ انت قلت بان الملف فيه اكواد (ان كانت الاكواد موجودة فانا اظن انها السبب) ولكن المرفق بدون اكواد!!! ابواحمد

بالاضافة الى حل اخي جمال الفار وكل الشكر له على جهودة الممتازة جرب اخي الكود التالي Sub OFFICNA() LR = Sheets("الفرز").Range("a" & Rows.Count).End(xlUp).Row Sheets("الفرز").Range("a1:a" & LR).Select Application.ScreenUpdating = False a = Selection.Columns.Count b = Selection.Rows.Count ActiveCell.Select For j = 1 To b x = 0 For i = 1 To a If ActiveCell.Interior.Pattern = xlNone Then x = x + 1 ActiveCell.Offset(0, 1).Select Next i If x = a Then ActiveCell.EntireRow.Hidden = True ActiveCell.Offset(1, -1).Select Next j ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True Sheets("الفرز").Range("a1:a" & LR).EntireRow.Hidden = False End Sub ولن تحتاج الى ورقة اخرى فالكود سيقو بالتالي 1. فرز الخلايا الملونة 2. طباعة المفروز 3. الغاء الفرز لتعود الورقة كما كانت ان شاء الله يفي بالمطلوب Q.rar

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

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

الاستاذ احمد زمان لا استطيع ان انكر مساعداتك ودعملك المتواصل لي ولغير فشكراً جزيلاً لك على مواقفك.

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

اخي الزير شكراً جزيلاً لك اخي سعد شكراً جزيلاً لك اخي فضل بارك الله فيك

بعد إذن استاذنا ومشرفنا هشام شلبي وانا معك في كل ما تقوله ولكن كون كتبت المعادلة فلا غضاضة من ارفاقها بفرض ان الخلية A2 هي خلية مدة الخدة فضع هذه المعادلة في اي خلية ولاحظ النتيجة اعتذر مرة اخر منك استاذ هشام ابواحمد =IF(A2<3;"لا يستحق";IF(AND(A2>=3;A2<5);"يستحق نصف";IF(AND(A2>=5;A2<10);"يستحق تلتي";IF(A2>=10;"يستحق المبلغ كاملاً"))))

بعد اذن الاستاذ احمد زمان اخي يمكنك استعمال الدالة TRUNCلاقتطاع عدد محدد من الارقام بعد الفاصلة دون تقريب والافضل ارفاق ملف ابواحمد

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

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

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

اخي ابو الحارث وجودك في الموضوع بحد ذاته شرف كبير لي يا صاحب الاخلاق الرفيعة فشكراً لدعمك الدائم وتشجيعك المتواصل ابواحمد

للعلم اخي ايهاب انك اذا قمت بتحريك الورقة فسيحدث خلل لان الكود قائم على استثناء الورقة ذات التسلسل 15 امنى ان تكون قد فهمت الية عمل الكود والله الموفق ابواحمد

ممتاز وخذ الملف وشاهد ما قمت بعمله واي سؤال انا حاضر ابواحمد أوفيسنا.rar