الحسامي

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

السلام عليكم تفضل الملف وتم التعديل ويت تحديد الخلايا المراد ضبطهامن خلال كود اخفاء المعادلات.rar

السلام عليكم فكما قال اخي وحبيبي يحيى بشأن تعداد الحلول هنا حل اخر Range([c2], Cells([c25000].End(xlUp).Row, 3)) = Empty For j = 1 To [a25000].End(xlUp).Value If Application.WorksheetFunction.CountIf(Range([a2], Cells([a25000].End(xlUp).Row - 1, 1)), j) = 0 Then [c25000].End(xlUp).Offset(1, 0).Value = j Next j Nr_not_in_the_list.rar

السلام عليكم فكرة ممتازة اخي الكريم ------------------------------------ يمكنك عمل الاكواد بطريقة وفكرة وتقنيات ابسط ارفقت لك بعض التعديلات عسى ان تستفيد منه REALIS1.rar

اخي الحبي بارك الله فيك هنا مرفق ملفين للحالتين عسى ان تستفيد منهما تقييد الطباعة بزر البرنامج1.rar تقييد الطباعة بزر البرنامج2.rar

السلام عليكم اخي الكريم بالنسبة للملف الاخير هنا شئ ناقص في الكود حيث انه يقوم بتعطيل الطباعة نهائيا حتى مع تخصيص زر للطباعة فيجب عليك اعادة الطباعة للتطبيق كما فعل اخي ابو نصار او يمكنك تعطيل حدث " ما قبل الطباعة " بإستخدام الأمر "EnableEvents" بحيث يكون كود زر الطباعة على النحو التالي Sub print_() Application.EnableEvents = False '.............. أمر الطباعة ......................... Application.EnableEvents = True End Sub أخي ابو نصار مجهود تشكر عليه بالفعل

اخي HaNcOcK بارك الله فيك على هذا المجهود الاكثر من رائع اخي قصي لا اعتقد انك ستجد افضل مما قدمه اخي HaNcOcK والله اعلم

السلام عليكم ورحمة الله وبركاته شكرا للاخ الحبيب يحياوي على فتح هذا الموضوع المميز والذي سيستفيد منه الجميع هنا مشاركة متواضعة لاثراء مواضيع الاكواد كيفية تخصيص كبسات لوحة المفاتيح لتنفيذ ماكرو مثلا لو كان لدينا ماكرو وقمنا بتسميته "main" Sub main() '......أكتب أي كود هنا لتنفيذه......... '............... '............... '............... '............... End Sub واردنا تخصيص زر "F1" لتنفيذه نستخدم الكود التالي Application.OnKey "{F1}", "main" ويمكنا ربط الزر "" بكبسات أخرى مثل "SHIFT" و "CTRL" و "ALT" بحيث نستخدم الرموز التالية للدلالة عليها SHIFT + CTRL ^ ALT % Application.OnKey "+{F1}", "main" ' <SHIFT> + <F1> Application.OnKey "^{F1}", "main" ' <CTRL> + <F1> Application.OnKey "%{F1}", "main" ' <ALT> + <F1> واذا اردنا الغاء التخصيص يعني لو اردنا ارجاع كبسة "F1" لتعمل وظيفتها السابقة نستخدم الكود التالي Application.OnKey "{F1}" وهنا قائمة للكبسات والازرار التي يمكننا تخصيصها BACKSPACE .............................. {BACKSPACE} or {BS} BREAK .......................................... {BREAK} CAPS LOCK ....................................... {CAPSLOCK} DELETE or DEL .............................. {DELETE} or {DEL} السهم للأسفل DOWN ARROW .............................. {DOWN} END .............................. {END} ESC .............................. {ESCAPE} or {ESC} F1 - F15 .............................. {F1} -{F15} HELP .............................. {HELP} HOME .............................. {HOME} INS .............................. {INSERT} السهم لليسار LEFT ARROW .............................. {LEFT} NUM LOCK .............................. {NUMLOCK} PAGE DOWN .............................. {PGDN} PAGE UP .............................. {PGUP} السهم لليمين RIGHT ARROW .............................. {RIGHT} SCROLL LOCK .............................. {SCROLLLOCK} TAB .............................. {TAB} السهم للاعلى UP ARROW .............................. {UP} ولكن يجب الحذر في استخدام هذه الازرار ومعرفة كيفية التعامل معها بتفعيلها وتعطيلها بحيث يتم تفعيلها في داخل الملف فقط ويمكنكم التعامل معها باستخدام احداث الصفحات وحدث فتح الملف واحدث اغلاق الملف

السلام عليكم اخي الكريم لا يوجد طريقة مباشرة على عمليات تعيين الماكرو ( على حسب ما أعلم ) ولكن يمكن ايجاد طرق اخرى لتعطيل تعطيل الماكرو وهنا مرفق يعمل على ذلك بحيث لن يعمل إلا على كبسة حسب اسمها وعند تعين الماكرو لاي كبسة لا تحمل الاسم المستخدم يتم الغاء الماكرو نهائيا ويمسح التعيين وكأنك لم تعين ماكرو بالاساس If Application.Caller <> "hosami" Then ActiveSheet.Shapes(Application.Caller).OnAction = "" Exit Sub End If وهنا الكبسة تم تسميته ب " hosami" ويمكنك التسمية بكتابة الاسم في شريط الدوال الذي يبن الخلية التي تم التوقف عندها عدم تعيين الماكرو.rar

ان شاء الله راني معاكم بصح عجبتني بزززااااااااااااف

اخي الحبيب هشام يا مرحبا يا مرحبا نورك غطى على الكهربا انت فين يا راجل وين الهوا راميك ------------------- اخي سعد جزاك الله كل الخير ولبسعادة اخي yahiaoui واش راك لا باس ... ويعطيك الصحة ديما

السلام عليكم اخي الحبيب ابن بلدي ابو عبدالله بارك الله فيك شاكرا مرورك الكريم ------------------------------------ اخي حسام غالي والطلب رخيص Prog.rar

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

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

السلام عليكم اخي العزيز شاهد المرفق عسى ان يكون ما تطلب Prog.rar

السلام عليكم ومن بعد اذن اخي خبور اخي الكريم ضع هذه الجزئية في بداية الكود فقط Set Start_Date = [e2]

السلام عليكم اخي ابو نصار استخدم الكود التالي Private Sub ComboBox1_Change() Application.ScreenUpdating = False [a3: ax2000].ClearContents ورقة1.[a3:az3].AutoFilter ورقة1.[a3:az3].AutoFilter Field:=6, Criteria1:=ComboBox1 ورقة1.Range("A4:Az2000").SpecialCells(xlCellTypeVisible).Copy Range("a3").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False ورقة1.[a3:az3].AutoFilter x = Range("b15000").End(xlUp).Row + 1 Cells(x, "b") = "المجمـــــــــوع" Cells(x, "c") = Application.WorksheetFunction.SUM(Range([c3], Cells(x, "c"))) Cells(x, "an") = Application.WorksheetFunction.SUM(Range([an3], Cells(x, "an"))) Cells(x, "ao") = Application.WorksheetFunction.SUM(Range([ao3], Cells(x, "ao"))) Cells(x, "aq") = Application.WorksheetFunction.SUM(Range([aq3], Cells(x, "aq"))) Cells(x, "aw") = Application.WorksheetFunction.SUM(Range([aw3], Cells(x, "aw"))) [d1].Select End Sub

السلام عليكم اخي الكريم يمكن تعطيل الادخال مباشرة وتفعيل مبدأ الاختيار من القائمة فقط عن طريق تفعيل خاصية MatchRequired من خلال نافذة الخصائص وجعلها True ------------ ويمكنك إستخدام الكود التالي كذلك لمنع ادخال اي ادخال غير موجود في القائمة Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean) Set mylist = Sheet1.[A1:A6] If Application.WorksheetFunction.CountIf([mylist], ComboBox1) = 0 Then ComboBox1.Value = Empty End Sub ومرفق مثال يوضح كلتا الحالتين عسى ان يلبي ما تطلبه combo box hosami.rar

السلام عليكم اخي الكريم فقط غير الجزئية Range("a3").PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False جلب بيانات مشكلة3.rar

السلام عليكم اخي الكريم مرفق جزء من ملفك ( فقط الصفحتان المستخدمتان في الفلترة ) حيث قمت بمسح الصفحات الاخرى والفورم وصفحات الاكواد لتقليل حجم الملف لاتمكن من ارفاقه ------------------------- المهم : تم تطبيق المطلوب فقط قم بنقل الاكواد كما هي لملفك الرئيسي وبنفس الاسلوب مع ملاحظة ان كبسة وكود مسح التعليقات يستخدم لمرة واحدة فقط ولا يتوجب عليك استخدامه في المستقبل جلب بيانات مشكلة3.rar

السلام عليكم اخي الكريم الخلل لديك ناجم عن وجود تعليقات مخفية"Comment" في صفحة "مسير" وهذه من اسباب عدم عمل نظام الفلترة في الملف وهي من اعداء الفلترة لذلك عليك اولا اضهار هذه التعليقات ومن ثم مسحها...استخدم الكود التالي لذلك For Each s In ورقة1.Shapes s.Visible = msoCTrue Next ورقة1.Cells.ClearComments ومن ثم إستخدم الكود التالي وهو نفس كود اخي وحبيبي ابو احمد مع اختصاره بعض الشئ Application.ScreenUpdating = False [a3: ax2000].ClearContents ورقة1.[a3:az3].AutoFilter ورقة1.[a3:az3].AutoFilter Field:=6, Criteria1:=ComboBox2 ورقة1.Range("A4:Az2000").SpecialCells(xlCellTypeVisible).Copy Range("a3").PasteSpecial Paste:=xlPasteValues ورقة1.[a3:az3].AutoFilter [D1].Select اما اذا اردت كود اخي هانكوك مع التعديل الذي اردته فقد قم بتغير الجزئية For R = 2 To .Range("ax2000").End(xlUp).Row الى الجزئية التالية ليتم اخذ المدى للعمود "E" For R = 2 To .Range("e2000").End(xlUp).Row

السلام عليكم اخي كماس اخي سعد عدل الكود على النحو التالي For i = 6 To ThisWorkbook.Sheets.Count Cells(i + 2, 3) = Sheets(i).Name Next i

السلام عليكم بعد اذن اخوتي واحبتي اخي كيماس عدد الشيتات تبدأ من 5 وبالتالي اذا تم البدأ من 8 سيتم تجاهل اخر 3 صفحات الكود يجب ان يكون على الشكل التالي : For i = 5 To ThisWorkbook.Sheets.Count Cells(i + 3, 3) = Sheets(i).Name Next i اخي ابو يعقوب فكرة واقتراح تلبي المطلوب تماما وتعطي نفس النتائج بشكل صحيح بارك الله فيك

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

السلام عليكم اخي الكريم والحبيب / دغيدي دائما فى القلب.. يــــــــــــــــــارب