حمادة عمر

جزاك الله خيرا اخي الحبيب / محمود الشريف جعلك الله دائما في عون الجميع تقبل خالص تحياتي

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

السلام عليكم الاخ الحبيب / أبو محمد عباس بارك الله فيك مجهود راائع وتميز حقيقي تقبل خالص تحياتي

السلام عليكم الاخ الحبيب / إبراهيم ابوليله بارك الله فيك بعد اذن اخونا الحبيب / محمود الشريف ... جزاه الله خيرا ولاثراء الموضوع ... وعلي حسب فهمي للطلب استبدل الكود الموجود بالفورم والخاص بالترحيل ... بالكود التالي Private Sub CommandButton3_Click() Sheet3.Select Lr = Sheet3.[A100000].End(xlUp).Row Range("A4:AA" & Lr).Clear For c = 1 To 10 Cells(3, c).ClearFormats Cells(3, c) = Me.Controls("Label" & c).Caption Cells(3, c).HorizontalAlignment = xlCenter Cells(3, c).Borders.LineStyle = xlContinuous 'Cells(3, c).Borders.Weight = xlMedium Cells(3, c).Font.Name = "Agency FB" Cells(3, c).Font.Size = 20 Cells(3, c).Font.Bold = False Next If ListBox1.ListCount = 0 Then Exit Sub Sheet3.Range("A4").Resize(ListBox1.ListCount, 10).Value = ListBox1.List Sheet3.Range("B4:B50").NumberFormat = "DD/MM/YYYY" Lr1 = Sheet3.[A100000].End(xlUp).Row + 1 Sheet3.Cells(Lr1, 5).Value = UserForm4.Label12 Sheet3.Cells(Lr1, 6).Value = UserForm4.Label13 Sheet3.Cells(Lr1, 7).Value = UserForm4.Label14 Sheet3.Cells(Lr1, 8).Value = UserForm4.Label15 Sheet3.Cells(Lr1, 9).Value = UserForm4.Label16 Sheet3.Cells(Lr1, 10).Value = UserForm4.Label11 End Sub واليك الملف به الكود بالمرفقات وفي انتظار ردك تقبل خالص تحياتي RECIP-SAMA.rar

السلام عليكم الاخ الحبيب / محمود_الشريف بارك الله فيك نشاط بالفعل متميز وملحوظ جدا جعل الله كل اعمالك في ميزان حسناتك تقبل خالص تحياتي

السلام عليكم الاخ الكريم / جمال حسين رشدان بارك الله فيك وبعد اذن الاستاذ / جمال الفار .. جزاه الله خيرا اليك الروابط التاليه اعتقد انها تفي بطلبك الرابط التالي للقدير / أبو حنين .. جزاه الله خيرا بعنوان ( تكملة تلقائية ) http://www.officena.net/ib/index.php?showtopic=49397&hl=%2B%D8%A7%D9%84%D8%AA%D9%83%D9%85%D9%84%D8%A9+%2B%D8%A7%D9%84%D8%AA%D9%84%D9%82%D8%A7%D8%A6%D9%8A%D8%A9 وشاهد الرابط التالي ايضا بعنوان ( الأكمال التلقائي ) http://www.officena.net/ib/index.php?showtopic=47978&hl=%2B%D8%A7%D9%84%D8%A7%D9%83%D9%85%D8%A7%D9%84+%2B%D8%A7%D9%84%D8%AA%D9%84%D9%82%D8%A7%D8%A6%D9%8A#entry290478 وشاهد الرابط التالي http://www.officena.net/ib/index.php?showtopic=49549&hl= وفي انتظار ردك تقبلوا خالص تحياتي

السلام عليكم الاخ الكريم / واصل بارك الله فيك اليك الكود بالشكل الصحيح ومتم تنفيذه علي ملفك بالمرفقات Sub sama_print() On Error Resume Next For i = 1 To Sheets.Count Sheets(i).Select Sheets(i).[AQ1].Value = "" With Sheets(i) Range("AQ1").Font.ColorIndex = 2 End With For Each cl In Range("a1:ao50") If cl = "غائب" Then [AQ1].Value = "غائب" Next If Sheets(i).[AQ1].Value = "غائب" Then Sheets(i).PageSetup.PrintArea = "a1:ao50" Sheets(i).PrintOut copies:=1 End If Next i Sheet1.Select End Sub شاهد ... وفي انتظار ردك تقبل خالص تحياتي PrintTranscriptTheSeparationOfTheFirst2a11.rar

السلام عليكم الاخ الحبيب / محمود_الشريف بارك الله فيك تقبل خالص تحياتي

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

جزاك الله خيرا

جزاك الله خيرا

جزاك الله خيرا

السلام عليكم الأخ الحبيب / محمود الشريف بارك الله فيك نشاط ملحوظ وتميز واضح تقبل خالص تحياتي

الأخ الكريم / واصل عذرا فالخطأ مني استبدل السطر الموجود بالكود و المظلل بالأزرق في الصورة بالسطر التالي =================== For i = 1 To Sheets.Count =================== حيث كان به خطأ نسيان الرقم 1 في الكود المرسل تقبل خالص تحياتي

الأخ الكريم / واصل بارك الله فيك ضع الكود التالي في موديل واربطه بزر .. لتنفيذ طلبك ان شاء الله ================ sub sama() On Error Resume Next For i = To Sheets.count Sheets(i).[AQ1].Value = "" With Sheets (i) Range("AQ1).Font.ColorIndex = 2 End with For Each cl In Range ("A1:AO50") If cl ="غائب" Then [AQ1].Value ="غائب" Next If Sheets (i).[AQ1].Value ="غائب" Then Sheets (i).PageSetup.PrintArea ="A1:AO50" Sheets (i).PrintOut Copies:=1 End If Next i Sheet1.Select End Sub وعذرا لعدم ارفاقي ملف حيث لدي عطل بالنت واقوم بالارسال لك عن طريق الموبايل وارجو من أحد الأخوة تنفيذه علي ملف ان لم يمكنك استخدامه تقبل خالص تحياتي

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

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

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

السلام عليكم الاخ الكريم / واصل بارك الله فيك ولكن عذرا اخي الكريم فالمطلوب غير واضح بالنسبة لي بعض الشئ وليسهل تنفيذ الطلب لي ولغيري ممن يمكنه المساعدة ارجو الرد علي بعض التوضيحات هل تقصد ان كل ورقة خاصة بطالب معين ؟ وهل تقصد انه اذا وجد اي كلمة غائب في هذه الصفحة في اي مادة .. تتم الطباعة فمثلا في مثالك المرفق لايوجد كلمة غائب الا في Sheet16 و Sheet28 هل تقصد طباعة هذين الشيتين كاملين فقط او مزيد من التوضيح تقبل خالص تحياتي

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

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

الاخ الكريم / ابو حنين لو ارفقت ملف سيكون افضل بكثير كمثال لما تريده بالضبط لايضاح الصورة اكثر وحسب فهمي لطلبك استخدم الكود التالي ... ارجو ان يفي بطلبك Private Sub CommandButton1_Click() Set Rng = ActiveSheet.Range("Aj22:Aj3000") On Error Resume Next x = Rng.Cells.Find(Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=True).Activate Unload Me If x = Empty Then MsgBox "الرقم الذي تبحث عنه غير موجود ", vbOKOnly, "رقم غير موجود" End Sub واليك المرفقات 2003 البحث في نطاق محدد ( عمود ) والذهاب لنتيجة البحث.rar

السلام عليكم استاذنا الفاضل القدير / جمال عبد السميع بارك الله فيك هل تريد ان تعلم مدي حب الجميع لك في قرارك هذا ... الكل اجمع علي حبك ومدي تعلقه بكم وباعمالكم هل تريد ان تجعل اسره هذا الصرح العملاق تقل واحد من عمالقته الذي لا يوجد مثله في الوطن العربي كاملاً ؟؟ هل تريد ان تترك تلاميذك واخوانك الذين تعلموا منك الكثير والكثير ويدينون لك بالفضل الكبير ؟؟ وسؤال آخر استحلفك بالله ... هل ستقدر علي البعد عن هذا المنتدي باعضاؤه ؟؟ نحتاجك ولو مرة كل اسبوع .. لتساعد الجميع فيما لايقدروا عليه نحتاج طلتك بيننا فقط كل اسبوع اعدل عن قرارك .... نستحلفك بالله تقبلوا خالص تحياتي

الاخ الكريم / ابو حنين لو ارفقت ملف سيكون افضل بكثير كمثال لما تريده بالضبط لايضاح الصورة اكثر وحسب فهمي لطلبك استخدم الكود التالي ... ارجو ان يفي بطلبك Private Sub CommandButton1_Click() Set Rng = ActiveSheet.Range("Aj22:Aj3000") On Error Resume Next x = Rng.Cells.Find(Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=True).Activate Unload Me If x = Empty Then MsgBox "الرقم الذي تبحث عنه غير موجود ", vbOKOnly, "رقم غير موجود" End Sub واليك المرفقات 2003 البحث في نطاق محدد ( عمود ) والذهاب لنتيجة البحث.rar