مختار حسين محمود

مشكور على مروركم أخى ياسر

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

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

أحسنت عمل رائع بارك الله فيك وزادك علما

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

الله عليك أنت يا أبو صلاح يظهر إن اللى حملوا الملف ما شفوش النتيجة

أحسنت وبارك الله فيك شرح يدل على أنك محترف اكسل . تخيًرالموضوعات التى يندُر الحديث فيها استمر تحياتى

أخى أبو زهرة جرب هذا الكود Sub ChangingPaperSize() Application.ScreenUpdating = False Dim Cl As Range blnAns = Application.InputBox("أدخل 3 للطباعة على ورق 3" & vbCr & "أدخل 4 للطباعة على ورق 4", "اختر نوع ورق الطباعة", , , , , , 4) If blnAns = 3 Then For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA3 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False Else For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA4 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False End If Rows("11:36").Select Selection.EntireRow.Hidden = False Range("A1").Select Application.ScreenUpdating = True End Sub

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

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

السلام عليكم ورحمة الله وبركاته وبعد موضوع اليوم من وجهة نظرى المحدودة فكرة لذيذة ونادرة على ما أعتقد الفكرة هى كما يبدو من العنوان ازاى نحذف محتوى الشيت مع استثناء مدى معين وفى المرفق الجميل اللى هتحمله أتحداك لو ما قلتش الله . تحياتى Delete all data on sheet except certain range .rar

جزاكم الله خيراً أخى ياسر تقبل تحياتى

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

أخى وأستاذى الفاضل ياسر خليل بارك الله فيكم أخى المهندس الفاضل ياسر فتحى بارك الله فيكم أخى الفاضل أحمد الرشيدى بارك الله فيكم وفى مروركم الكريم

السلام عليكم ورحمة الله وبركاته اليوم أعود إليكم اخوانى بعد غياب بهدية بسيطة لكن قد تصبح جوهرة ثمينة عندك فى يوم ما ده لما ربنا يكرمك وتعمل شركة سوفت وير أو محمول قل إن شاء الله باختصار جُل أمور حياتنا وأعمالنا وأشغالنا كلها بقت بباسورد إما يكون بسيط أو معقد وكلاهما قابل للكسر يعنى مفيش مفر من أخى وأستاذى ياسر خليل لكن الشركات دى بتعمل سريال نمبر ازاى لكل مستخدم ؟ لو الشركة عايزه تعمل سريال يمشى الحال بتستعمل الكود التالى Sub Passwordgenerator() Do 'أمربمعنى افعل ' شرط بمعنى لو كانت الخلية التى بجانب الخلية النشطة مملوءة If ActiveCell.Offset(0, -1) <> "" Then 'ضع المعادلة التالية فى الخلية النشطة ActiveCell.Formula = Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "00000") 'الانتقال الى الخلايا التالية للخلية النشطة ActiveCell.Offset(1, 0).Select Else 'أيضا لو لم تكن الخلية التى بجانب الخلية النشطة مملوءة Exit Sub 'اخرج من الاجراء End If 'انتهاء جملة الشرط Loop 'استمر End Sub الكود وظيفته توليد سريال حرف عشوائى + رقم عشوائى وأهم ما فيه السطر العبقرى ده : ActiveCell.Formula = Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "00000") الشرح : Chr دالة النصوص CHAR تعطى حرف عشوائى مساوى لرقم معين Int دالة تقريب لأقرب عدد صحيح 26 عدد حروف اللغة الانجليزية Rnd دالة تعطى رقم عشوائى 97 لجعل الحرف الناتج يكون صغير صمول 65 لجعل الحرف الناتج يكون كبير كبتل اشمعنى الرقم 97 والرقم 65 الرقم 65 يساوى A أول حرف كبتل فى اللغة الانجليزية الرقم 66 يساوى B ثانى حرف كبتل فى اللغة الانجليزية وهكذا الرقم 97 يساوى a أول حرف صمول فى اللغة الانجليزية الرقم 97 يساوى b ثانى حرف صمول فى اللغة الانجليزية وهكذا أعتقد أن الفكرة زادت وضوحا Format(Int(100000 * Rnd), "00000 " هنا نتحكم فى عدد الأرقام التى تلى الحرف العشوائى 4 أو 5 أو 6 ...الخ ببساطة جرب تغيير الأصفار فى الشقين بالزيادة والنقصان ولو الشركة عايزه تحبكها شوية بتعمل ايه ؟ بتغير فى السطر العبقرى تضيف عليه معادلة أخرى مماثلة أو مختلفة مثل : ActiveCell.Formula = Chr(Int((26 * Rnd) + 65)) & Format(Int(100000 * Rnd), "00000") & Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "00000") أو زى كده : ActiveCell.Formula = Chr(Int((26 * Rnd) + 65)) & Format(Int(100000 * Rnd), "00000") & Chr(Int((26 * Rnd) + 97)) & Format(Int(100000 * Rnd), "00000") & Chr(Int((26 * Rnd) + 65)) & Format(Int(100000 * Rnd), "00000") ولو الشركة عايزه تحبكها شويتين بتعمل ايه ؟ بتغير فى السطر العبقرى وتعمل سريال مجموعات مجموعات مثل : ActiveCell.Formula = Chr(Int((26 * Rnd) + 65)) & Format(Int(1000 * Rnd), "000") & " - " & Chr(Int((26 * Rnd) + 97)) & Format(Int(1000 * Rnd), "000") & " - " & Chr(Int((26 * Rnd) + 65)) & Format(Int(1000 * Rnd), "000") & " - " & Chr(Int((26 * Rnd) + 97)) & Format(Int(1000 * Rnd), "000") ولو الشركة عايزه تعمل سريال مخصوص لأوفيسنا بتعمل ايه ؟ بتغير فى السطر العبقرى وتعمل سريال مجموعات مجموعات وتضع اسم أوفيسنا فيهم زى كده : ActiveCell.Formula = Chr(Int((26 * Rnd) + 65)) & Format(Int(1000 * Rnd), "000") & " - " & Chr(Int((26 * Rnd) + 97)) & Format(Int(1000 * Rnd), "000") & " - " & "officena" & " - " & Chr(Int((26 * Rnd) + 97)) & Format(Int(1000 * Rnd), "000") & " - " & Chr(Int((26 * Rnd) + 65)) & Format(Int(1000 * Rnd), "000") ملحوظة : الكود الأصلى هو المذكور فى بداية الموضوع وهو منقول من مشاركة فى أحد المنتديات الأجنبية أما ما تلاه من أكواد فى ثنايا الشرح هى من وحى الخيال ويمكنك أن تعيد تشكيل السطر العبقرى بالتعديل والاضافة كما تشاء مين بقى هيتفاعل مع الموضوع ويقدم لنا شكل جديد للكود ؟ طبتم وطاب مساءكم والسلام عليكم ورحمة الله Password generator.rar

أشكرك أستاذى الفاضل سليم على الإضافة كما أشكر أخى وأستاذى ياسر على الزيادة .

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

المرفق بعد التعديلات بتنسيق 2003 راسب فنى بدون دائرة على الدرجة.rar

أشكرك يا أستاذ محمد لكن تم التعديل بالتبديل فنزلت الدوائر على الدرجة فقط دون المستوى ولما أضفت الجملة c.Offset(1, 0).Value = "دون المستوى" كشرط جديد تم نحقيق الهدف الدوائر نزلت على الدرجة ودون المستوى بارك الله فيكم وجازكم عنا خير الجزاء أستاذى العزيز

أخى الكريم نحن نتحكم فى مدة الطباعة بطريقة غير مباشرة عن طريق التحكم فى عدد الأوراق يعنى لو عدد الأوراق طلع 60 ورقة قسم ذلك على مرتين أو ثلاث يعنى اطبع من 1 الى 20 ثم ريح الطابعة ثم اكتب من 21 الى 40 ثم ريح الطابعة ثم اكتب من 41 الى 60 وهكذا هل وصلت الفكرة ؟ أم أنك تريد شيئا آخر ؟ تم اضافة شيت بحث مطابق تماما لشيت الشهادة مع اضافة قائمة منسدلة للبحث تذكرنى بالخير كلما طبعت على هذه الطابعة المسكينة طباعة مرن مع البحث بدلالة رقم الجلوس.rar

أستاذ محمد بارك الله فيكم عندى مشكلة أيضا مشابهة أنا أستخدم هذا الكود على الشهادات وعندى طالب راسب فنى فى مادة مثل العربى واخد 55 درجة من 100 لكن لم يحصل على الـــ 30 % فى التحريرى أخر العام والتقدير طبعا دون المستوى ودرجة النجاح 50 بتزل الدائرة الحمراء على التقدير دون المستوى لكن لا تنزل على الدرجة 55 حيث أنها أكبر من درجة النجاح تفضل المرفق التالى :كنموذج مصغر من الكنترول شيت راسب فنى بدون دائرة على الدرجة.rar

أخى الكريم / طالب علم مجتهد راجع التوجيهات للأعضاء الجدد فى الصفحة الرئيسية للمنتدى بعد كده اجتهد فى البحث فى المنتدى موضوعات كثيرة خاصة بالترحيل تحياتى

فتح ملف وورد من الاكسل من خلال الكود التالى ( كود عادى ) Sub Open_Word_Document() 'Opens a Word Document from Excel Dim objWord As Object Set objWord = CreateObject("Word.Application") objWord.Visible = True Application.ScreenUpdating = False Application.DisplayAlerts = False 'عدل مسار واسم وامتداد الملف الذى تريد فتحه objWord.Documents.Open "H:\test.docx" objWord.Activate Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub عدل مسار واسم وامتداد الملف الذى تريد فتحه أما عن الأستفادة من مميزات وتنسيقات الاكسل سأتركها لك لتكتشف ذلك بنقسك !!!

لا يا أخى لم أنسك وإنما مسألة وقت وعندى امتحانات ضف على ذلك الكهرباءءءء ولو نسيت هتلاقى الأخوة هنا لا يتأخرون وعذرا على التأخر تفضل عله يكون المطلوب عملت لك تعديل على عدد الشهادات فى الورقة 2 فقط الشهادات سوف تتغيير آلياً وومكن يدويا بـ Spinner هتلاقى عدد الطلاب وعدد الأوراق المطلوبة للطباعة محدد بمعادلات كل اللى عليك تضع عدد الأوراق التى تريدها ثم اضغط الزر طباعة طباعه مرن.rar

ارفق ملف للعمل عليه تحياتى