بن علية حاجي

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال... وجمعة مباركة أخي الكريم إن كنت قد فهمت المطلوب والشرح، هذه محاولة في الملف المرفق (مع إضافة عمود للضرورة)... أخوك بن علية Comb.rar

السلام عليكم ورحمة الله أخي الكريم، أمر المسح كان موجودا أصلا في الكود ولكنه متعلق بالعمود B وبالتالي يكون الكود بعد التعديل عليه كما يلي: Private Sub Worksheet_Selectionchange(ByVal Target As Range) A = "A" 'ÚãæÏ ÇáÊÓáÓá B = "B" 'ÚãæÏ ÇáÈíÇäÇÊ R = 6 'ÇáÈíÇäÇÊ ÊÈÏà ãä ÇáÕÝ '================================================= L = Range(B & 65000).End(xlUp).Row If L < R Then Exit Sub Range(Cells(R, A), Cells(Range(A & 65000).End(xlUp).Row, A)).ClearContents '================================================= For I = R To L If Cells(I, A) = "" And Cells(I, B) <> "" Then N = N + 1 For ii = I To L If Cells(ii, B) = Cells(I, B) Then Cells(ii, A) = N End If Next ii End If Next I End Sub أخوك ين علية

السلام عليكم ورحمة الله تقبل الله صلاة وصيام وقيام الجميع بالمزيد من الأجر والثواب... أخي الكريم يمكنك إضافة أمر مسح محتويات العمود الأول قبل تنفيذ الكود... مثلا : ضف السطر التالي في الكود قبل سطر الـ IF الأولى : Range("A6:A65000") = Empty فيكون الكود في النهاية كما يلي: Private Sub Worksheet_Selectionchange(ByVal Target As Range) A = "A" 'ÚãæÏ ÇáÊÓáÓá B = "B" 'ÚãæÏ ÇáÈíÇäÇÊ R = 6 'ÇáÈíÇäÇÊ ÊÈÏà ãä ÇáÕÝ '================================================= Range("A6:A65000") = Empty L = Range("B65000").End(xlUp).Row If L < R Then Exit Sub Range(Cells(R, A), Cells(L, A)).ClearContents '================================================= For I = R To L If Cells(I, A) = "" And Cells(I, B) <> "" Then N = N + 1 For ii = I To L If Cells(ii, B) = Cells(I, B) Then Cells(ii, A) = N End If Next ii End If Next I End Sub أخوك ين علية

السلام عليكم ورحمة الله تقبل الله منا ومنكم كل أعمال الخير... أخي الكريم هذا حل آخر ... أخوك بن علية الرتب والدرجات.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال... أخي مصطفى، فهمت المطلوب وحاولت اختصار المعادلات دون جدوى... أرجو أني وفقت في تقديم جزء من المطلوب في الملف المرفق... اقتراح: يستحسن حفظ الملف بصيغة .xlsb بدلا من الصيعة .xlsm أخوك بن علية Payroll Tax - 2012.rar وهذه نسخة على أوفيس 2003 للفائدة... Payroll Tax-2012.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح العمال.... أخي الكريم، تم تحضير كود بسيط (تحويل المعادلة المقترحة في الملف السابق إلى كود) يقوم بالعملية المطلوبة... أرجو أن يكون مقبولا أو انتظر من الأعضاء الكرام الذين لهم باع كبير في VBA حتى يدلوا بما فضل الله عليكم من علم ويقدموا أكوادا أفضل من الذي وضعته في الملف المرفق... أخوك بن علية تسلسل2.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصيام والقيام وصالح الأعمال.... أخي الكريم، باستعمال أداة أخرى تم المطلوب في المرفق.... أخوك بن علية Book3.rar

السلام عليكم ورحمة الله تقبل الله صيام وقيام الجميع.... أخي الكريم تجد في الملف المرفق حلا لمسألتك... أخوك بن علية... مرتبات.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصلاة والصيام والقيام وصالح الأعمال.... أخي الكريم هذا حل كبداية باستعمال المعادلات... في انتظار حلول أخرى من إخوتنا الكرام... أخوك بن علية تسلسل.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصيام والقيام وصالح الأعمال... أخي الكريم، وهذا حل آخر يعتمد تكرار أسماء العملاء في العمود الأول... أخوكم بن علية Book2.rar

السلام عليكم ورحمة الله تقبل الله منا ومنكم الصيام والقيام وصالح الأعمال... أخي الكريم وأستسمح أخي العزيز رجب لأقوم بتغيير طفيف على كوده حسب المطلوب الجديد... في الكود الخاص بطباعة المحدد عليك تغيير السطر For I = Range("E1") To Range("F1") بالسطر For I = Range("E1") To Range("F1") Step 2 والله أعلم

السلام عليكم ورحمة الله أخي الكريم يوسف، عليك وحشة اشتقنا إليك كثيرا ربما كنت أنا الغائب... بالنسبة للمطلوب وحسب ما فهمت إليك بالحل التالي في الملف المرفق وأرجو أني وفقت فيه... أخوك بن علية Market Data.rar

السلام عليكم ورحمة الله أخي الكريم فضل، بفضل الله ثم بمعادلة بسيطة تم المطلوب... لا تنسونا بدعائكم الصالح، ولا تنسو الدعاء لابنتي في ظاهر الغيب... أخوك بن علية توزيع المواد تحت اسماء اعمدتها.rar

السلام عليكم ورحمة الله أخي الكريم، إن خطأ الكود في عدم إيجاد الصورة وارد جدا لأن عند كل إدراج لصورة في ملف يتغير اسم الصورة وفي الكود اسم الصورة ثابت "Picture 23" وهذا سبب الخطأ... وأقترح تغيير السطر التالي في الكود: ActiveSheet.Shapes.Range(Array("Picture 23")).Select بالسطر (مع الحذر أنه يقوم بتحديد كل الصور والمربعات) ActiveSheet.DrawingObjects.Select والخلل في بطء تنفيذ الكود راجع (حسب رأيي) إلى أمر الطباعة ذاته المتمثل في السطر : Selection.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False ولما استبدل بالأمر : ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True كان تنفيذ الكود أسرع... والله أعلى وأعلم

السلام عليكم ورحمة الله أخي الكريم، صحيح أن الكود به خطأ لأن كلمة Range خاصة ولتصحيح الخلل يكفي استبدال هذه الكلمة (في تسمية النطاق وفي الكود) بكلمة أخرى مثل Data أو Plage أو غيرها.... وفي الملف المرفق حل للمسألة (وقد تم تجربته)... ومعذرة على هذا الخطأ غير المقصود... أخوك بن علية مطلوب كود طباعة.rar

السلام عليكم ورحمة الله أخي الكريم، تم إنشاء تسمية نطاق Range بوساطة المعادلة التالية: =OFFSET('الاصـــــناف '!$A$1:$G$1;;;MAX('الاصـــــناف '!$A:$A)+3) ثم إنشاء الكود البسيط التالي وربطه بالزر Print المرفق بالورقة: Sub Printing() [Range].PrintOut Copies:=1, Collate:=True End Sub أرجو أن يكون المطلوب... وأطلب منكم الدعاء لابنتي بالشفاء... أخوكم بن علية مطلوب كود طباعة.rar

السلام عليكم ورحمة الله أخي الكريم أبو حنين أشكرك كثيرا على الكود الجميل لحل المطلوب غير أن السطرين : If Target.Column = 11 Then و End If غير ضروريان في الكود، والكود يكون مختصرا كما يلي: Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 11 Then Exit Sub Range("A7:L1000").Sort Key1:=Range("K7"), Order1:=xlAscending End Sub هذه مجرد ملاحظة والكود جميل جدا... أخوك بن علية

السلام عليكم ورحمة الله أخي الكريم رجب كود رائع جدا أحسنت إبداعا... وهذا حل آخر بالمعادلات مع عمود إضافي... أخوك بن علية ترقيم.rar

السلام عليكم ورحمة الله أخي الكريم هذه محاولة في الملف المرفق أرجو أن تكون بعضا من الحل... أخوك بن علية Coding.rar

السلام عليكم ورحمة الله إخواني الكرام كان من المفروض أن لا يقدم للمسألة حلول لأن عنوان الموضوع مخالف ولا يدل على المطلوب... أخوكم بن علية

السلام عليكم ورحمة الله * أكتب أو قل "إنا لله وإنا إليه راجعون" ولا تكتب أو تقول إن لله وإن إليه راجعون * أكتب إن شاء الله ولا تكتب إنشاء الله والله أعلم

السلام عليكم ورحمة الله أخي الكريم، تم إضافة تنسيقات تجميلية للملف... أخوك بن علية سودوكو.rar

السلام عليكم ورحمة الله أخي الكريم كما وعدتك في تحضير ملف عام نختار فيه عدد المترشحين في القاعة الواحدة (15 أو 20 أو غيرها)... الملاحظات السابقة تبقى كما هي عدا الثالثة، التي يتم فيها تخصيص عدد المترشحين في كل قاعة لا يتم بتغيير (إضافات) على اسم الشعبة بل يتم هذه المرة بكتابة "رقم اللجنة" في بداية كل قائمة (يداية كل قاعة) فقط وترك التي تليها فارغة في القاعة نفسها... أرجو أن يكون الملف سهل الاستعمال ومفيدا لمن يحتاجه... ملاحظة : قمت بوضع نموذجين لمخطط القاعات (مخطط لـ15 مترشح في كل قاعة ومخطط لـ20 مترشح في كل قاعة)... أخوكم بن علية Listes_BAC.rar

السلام عليكم ورحمة الله إخواني الكرام، قمت فيما مضى بإعداد ملف خاص بالبكالوريا وسبق أن وضعته في المنتدى... وحسب المستجدات تم إعداد ملف خاص بمراكز امتحان البكالوريا للأحرار (15 مترشح على الأكثر).... وأضع بين أيديكم هذا الملف راجيا أن أجد عندكم الوقت لتجريته وتحديد أخطائه ونقائصه لأتمكن من تصحيحها وتعديلها ليعمل الملف بصفة صحيحة وملاحظاتكم ستساعدني في مشروعي الجديد لتحضير ملف عام لجميع الحالات في وسائط متعددة (وقد باشرت العمل عليه)... في انتظار ملاحظاتكم تقبلوا تحياتي الخالصة... ملاحظات: 1- لمن أراد التغيير في أوراق الملف المحمية بكلمة السر الوحيدة hb 2- ورقة البيانات Base تملأ بصفة عادية وأرقام التسلسل والقاعات (الأعمدة الملونة بالأخضر) تملأ تلقائيا (بالمعادلات) 3- بالنسبة للقاعات التي تحوي أقل من 15 مترشح يتم كتابة اسم الشعبة بشكل آخر (إضافة فراغ مثلا) مثال : شعبة "آداب وفلسفة" نكتبها "آداب و فلسفة" (تم إضافة مسافة فراغ بين حرف "و" وكلمة "فلسفة") وهكذا... أخوكم بن علية Listes_BAC_15.rar

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