ياسر خليل أبو البراء

الأخ الحبيب رشراش علي مشكور على كلماتك الرقيقة الأخ أستيكة (همسحك بأستيكة لو مغيرتش اسمك للغة العربية ههه) جزيت خيراً على مرورك الكريم مشكور على مرورك الطيب والعطر أخي الكريم غسان بارك الله فيك وجزاك الله خيراً

أخي الفاضل تركي اعذرني ..لن ألتفت على الإطلاق للمرفق في المشاركة رقم 9 لأسباب كثيرة أهمها على الإطلاق : أنه يراعى عند طرح موضوع أن يكون الملف المرفق معبر عن الملف الأصلي بشكل كبير حتى يتم العمل بشكل صحيح من البداية عموما جرب الملف التالي وهو تطوير للملف في المشاركة رقم 8 .. يرجى تجربة الكود على الملف المرفق الذي سأدرجه الآن وليس على الملف الخاص بك فالكود مناسب للملف المرفق وليس لملفك ..فعند تجربة الكود وإعطاء النتائج يرجى إخبارنا بالنتائج هل صحيحة أم لا في الملف الذي أرفقه ... Exract Data Based On Conditions YasserKhalil.rar

أخي الفاضل الشاب يوسف الملف غير منطقي على الإطلاق يرجى مراجعة الملف المرفق .. حيث أن عملية الترحيل تعتمد على شرطين هما المرحلة واسم المدرسة طيب لو حبيت أرحل الأسماء الموجودة في ورقة 1 إلى ورقة 2 : الـ 16 اسم هيترحلوا إزاي في صف واحد (الصف التاسع في ورقة 2) أو يمكن أكون فهمت المطلوب بشكل خاطيء تقبل تحياتي

الأخ الفاضل ياسين أبو وسام جرب الملف التالي .. حاولت أن أقوم بتنفيذ أكواد تقوم بحذف صناديق النصوص الموجودة في ورقة العمل إلا أنه يبدو أن هناك عدد كبير منها ولذا استغرق الكود وقت طويل جداً فقمت بالتحايل وقمت بنسخ ورقة العمل التي بها هذا العدد الكبير من صناديق النصوص ، وعملية النسخ تستثني الأشكال .. Sub CopySheetWithoutShapes() 'يقوم الكود بنسخ ورقة العمل بدون أي أشكال ويحذف ورقة العمل ثم يقوم بتسمية ورقة العمل الجديدة بنفس الاسم القديم Dim strName As String Application.CopyObjectsWithCells = False Application.DisplayAlerts = False strName = "000" With ThisWorkbook.Sheets(strName) .Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) .Delete End With ActiveSheet.Name = strName Application.DisplayAlerts = True Application.CopyObjectsWithCells = True End Sub أرجو أن يؤدي الغرض ويحل المشكلة في الملف المرفق لم يتم تنفيذ الكود لتقوم بتنفيذه بنفسك .. قبل التنفيذ لاحظ مشكلتك ما زالت قائمة قم بالضغط على مفتاحي Alt + F11 ثم اختار اسم الماكرو المراد تنفيذه CopySheetWithoutShapes ثم أخيرا انقر RUN Draft.rar

أخي الكريم ياسين يوجد عدد كبير جداً من صناديق النصوص Textboxes .. هل تم نسخ البيانات في ورقة العمل من مكان آخر أم كيف تم إدراج كل هذا العدد من صناديق النصوص؟

الأخ الحبيب الغالي مختار جزيت خيراً على الكود الرائع فقط جزئية بسيطة جداً لم تعجبني ..ألا وهي وجود امتداد الملف في اسم الملف المصدر قم بتغيير السطر إلى fName = Left(ThisWorkbook.Name, (InStrRev(ThisWorkbook.Name, ".", -1, vbTextCompare) - 1)) & " " & .Range("C10").Value تقبل تحياتي

الأخ الفاضل مروان يرجى تغيير اسم الظهور للغة العربية .. راجع التوجيهات هااااااااااااام وضروري http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147 كما يرجى تحديد المشاركة التي أعجبتك كأفضل إجابة .. نفسي نتعلم النظااااااااام تقبل تحياتي

أخي الفاضل راجع التوجيهات على هذا الرابط أولاً http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147 يبدو أنك لم تستجيب للمشاركة رقم 2 و 3 ..

الأخ الكريم رجب يرجى تغيير اسم الظهور للغة العربية لسهولة التواصل يرجى مراجعة رابط التوجيهات http://www.officena.net/ib/index.php?s=d6ea3650efcc28c459c126a6e93260f7&showtopic=60147 بالنسبة لمشكلتك جرب تغير رقم 20 إلى 30 (لاحظ أن رقم 20 يوجد مرتين) Sub AddPageBreaks() Dim R As Long, LR As Long LR = Sheet1.[A99999].End(xlUp).Row ActiveSheet.ResetAllPageBreaks For R = (15 + 30) To LR Step 30 ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1) Next End Sub أو قم بإرفاق ملف للإطلاع عليه إذا ظلت المشكلة موجودة تقبل تحياتي

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

عارف إنك ممكن تكسل تقرا المشاركة اللي فاتت فعملت لك فيديو ع السريع تقبل تحياتي

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

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

أخي الكريم يوسف يرجى تغيير اسمك للغة العربية راجع الرابط التالي للضرورة http://www.officena.net/ib/index.php?s=93d6366e214279286e15f9cd20b60f7d&showtopic=60147 **************************** بالنسبة لكيفية عمل الملف المرفق كل اللي عملته معادلة واحدة وبسيطة جدا جدا =SUMIF(Sheet1!$A$2:$A$13,$A2,Sheet1!$B$2:$B$13) في المعادلة تم استخدام دالة واحدة فقط ، وهي دالة تسمى SUMIF أي لو ترجمتها هتلاقي الترجمة بتقول (اجمع لو) يعني الجمع بشرط ..كدا تكون فهمت الغرض من الدالة كل دالة في الإكسيل لها حاجة اسمها بارامترات الدالة .. لما بنكتب اسم الدالة وبعدين نفتح القوس بالضغط على Shift + 9 من لوحة المفاتيح ، الإكسيل بيظهر لنا تلميح بالبارمترات الخصة بكل دالة البارامتر الأول اسمه range ودا النطاق اللي هتشوف فيه الشرط المطلوب .. البارامتر الثاني اسمه criteria ودا الشرط المطلوب اختباره داخل النطاق اللي فات .. والبارامتر الثالث اسمه sum_range ودا النطاق المطلوب جمع قيمه في حالة لو الشرط اتحقق .. أظن كدا إن شاء الله تكون الأمور وضحت.. نرجع للمعادلة ونشوف كل بارامتر لوحده الأول Sheet1!$A$2:$A$13 دا النطاق في ورقة العمل Sheet1 .. ودا المفروض بيتم اختبار كل خلية داخل النطاق ويشوف الشرط الثاني $A2 الشرط موجود في الخلية A2 الخلية اللي جنب المعادلة الثالث Sheet1!$B$2:$B$13 دا النطاق اللي هيتجمع ، بس الجمع مش هيكون غير للقيم اللي اتحقق الشرط في النطاق الأول بالنسبة للمسافة الزائدة .. لو عملت دبل كليك داخل أي خلية فيها أي اسم من الأسماء وضغطت على مفتاح Home هتلاقي مؤشر الكتابة راح لأول الخلية ، ولو ضغطت مفتاح End من لوحة المفاتيح هتلاقي المؤشر راح لآخر الخلية لما تروح لآخر الخلية هتلاقي إن فيه مسافة زيادة .. تقوم من لوحة المفاتيح تضغط مفتاح Backspace عشان تحذف المسافة الزائدة أما لو كان عندك أسماء كثيرة وتريد أن تتخلص من المسافة الزائدة في كل الأسماء فيوجد دالة اسمها Trim لنفترض أن الاسم الذي به المسافات الزائدة موجود في الخلية A1 .. تيجي مثلا في الخلية B1 وضع المعادلة التالية =TRIM(A1) سيتم إزالة المسافات الزائدة وبعد كدا ممكن تسحب المعادلة .. وبعدين تحدد الخلايا الجديدة اللي فيها المعادلة وتعمل نسخ وتروح للعمود الأول اللي فيه الاسماء اللي فيها مشكلة المسافات الزائدة وكليك يمين Paste Special ثم نسخ القيم فقط Values .. وتحذف العمود اللي فيه المعادلات Trim .. أرجو أن تكون قد استفدت تقبل تحياتي

الأخ الفاضل يرجى تغيير اسمك للغة العربية كما يرجى تحديد الإجابة التي أعجبتك كأفضل إجابة اطلع على هذا الرابط .. ضروري وهام جداً http://www.officena.net/ib/index.php?s=93d6366e214279286e15f9cd20b60f7d&showtopic=60147

أخي في الله وأستاذي ومعلمي (ولن أنسى أبداً أني تتلمذت على يديك) لا يجوز لي - حتى لو بدا لك أني تحسنت بعض الشيء - لا يجوز لي أبداً أن أتعدى أستاذي بارك الله لنا فيك ، وكلامك وسام على صدري وفخر لي جزيت عنا خير الجزاء وجمعنا الله في الجنة في الفردوس الأعلى تقبل ودي وحبي واحترامي

النموذج المرفق غير معبر عن طلبك على الإطلاق ولم تحدد ما نوع التغيير الذي ترغبه ..ما هو التغيير المطلوب ؟ وهل التغيير يكون في كل المصنفات في كل أوراق العمل ؟؟ يرجى إعادة طرح طلبك بشكل أفضل

أخي وحبيبي في الله حسام مشكور على مرورك العطر وعلى كلماتك الطيبة (كلماتك لي بمثابة البنزين للعربية ومش أي بنزين دا بنزين 92 ..) تقبل تحياتي

أخي الحبيب عبد العزيز أقولها لك كلمة واحدة فقط (( كن أنت من يُزار ))

أخي وحبيبي في الله وأستاذي الكبير طارق لكم تشتاق نفسي لرؤية مشاركاتك بالمنتدى ، فمنكم تعلمنا وما زلنا ننهل من علمكم الغزير .. بارك الله فيك وجزاك الله خيراً على هذا الكود المميز والرائع أحببت أن أشارك ولو بشيء بسيط ، مشاركتي مجرد شرح بسيط جداً للكود حتى يستفيد الأخوة الكرام من الكود Sub AddPageBreaks() Dim R As Long, LR As Long 'تحديد رقم آخر صف به بيانات في العمود الأول LR = Sheet1.[A99999].End(xlUp).Row 'إعادة ضبط كل فواصل الصفحات ActiveSheet.ResetAllPageBreaks 'يمكنك استبدال الرقم 15 برقم أول سطر بعد العناوين 'يمثل الرقم 20 عدد الأسطر أو الصفوف المطلوبة في كل صفحة For R = (15 + 20) To LR Step 20 'عمل فاصل للصفحات قبل نهاية كل حلقة تكرارية ActiveSheet.HPageBreaks.Add Before:=Cells(R, 1) 'الانتقال للحلقة التالية Next End Sub تقبل ودي وحبي واحترامي وتحياتي أستاذي ومعلمي الباشمهندس طارق

السلام عليكم ورحمة الله وبركاته إخواني الأعزاء في المنتدى الأغر أقدم لكم حيلة بسيطة جداً .. ألا وهي : نسخ صورة لنطاق وعمل ارتباط للصورة بهذا النطاق يعني عندنا نطاق بيانات ، عايزين ناخد صورة من هذه البيانات وفي نفس الوقت تكون الصورة مرتبطة بأي تغير يحدث في النطاق الشرح داخل الفيديو على هذا الرابط مرفق لكم الملف لتقوموا بالتطبيق عليه ، دا للي مهتم بالتطبيق ! كان معكم أخوكم أبو البراء في حلقة Take Away دمتم في رعاية الله Test.rar

أخي الفاضل رغم كل الشرح الطويل .. الأمور ليست واضحة تماما .. ولذا طلبت منك إرفاق بعض النتائج للعمل على أساسها بالنسبة للخلية أ و ب و ج .. لم أفهم المطلوب عموما جرب الملف التالي .. تم عمل كود واحد كل أوراق العمل بحيث عندما تقوم بالنقر على زر الأمر يقوم الكود باستدعاء كل البيانات الخاصة بكل مهنة Sub SheetA() Dim WS As Worksheet, SH As Worksheet Dim lRow As Long, Cell As Range Set WS = Sheets("SQ"): Set SH = Sheets("A") lRow = 28 Application.ScreenUpdating = False For Each SH In Worksheets If SH.Name <> "SQ" And SH.Name <> "ATTEND" Then SH.Range("B28:J230").ClearContents With WS For Each Cell In WS.Range("J2:J" & .Cells(Rows.Count, "J").End(xlUp).Row) If Cell.Value = SH.Range("A27").Value Then SH.Cells(lRow, "B") = lRow - 27 SH.Cells(lRow, "C") = Cell.Offset(, -6) SH.Cells(lRow, "D") = Cell.Offset(, -3) lRow = lRow + 1 End If Next Cell End With End If lRow = 28 Next SH Application.ScreenUpdating = True End Sub تقبل تحياتي AutoFilter Multi Criteria YasserKhalil V1.rar

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

عموماً بعد عدة محاولات استطعت التغلب على الأمر إليك الملف التالي عله يفي بالغرض Private Sub Worksheet_Change(ByVal Target As Range) Dim X If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 1 And Target.Column = 3 Then Application.EnableEvents = False If IsEmpty(Target.Value) Or IsEmpty(Target.Offset(, -2)) Then Target.Value = "" ElseIf Target.Value = "تر" Then Target.Value = "تعديل راتب" ElseIf Target.Value = "تظ" Then Target.Value = "تظلم" ElseIf Target.Value = "اب" Then Target.Value = "إضافة بيانات" ElseIf Target.Value = "ن" Then Target.Value = "نقل" ElseIf Target.Value = "اخ" Then Target.Value = "إنهاء خدمة" ElseIf Target.Value = "ج" Then Target.Value = "أجازة" Else Target.Value = Target.Value End If Application.EnableEvents = True End If If Target.Row > 1 And Target.Column = 1 Then Application.EnableEvents = False On Error Resume Next X = Target.Value Target.Value = Application.WorksheetFunction.VLookup(Target.Value, Sheet2.Range("A2:C11"), 2, 0) Target.Offset(, 1).Value = Application.WorksheetFunction.VLookup(X, Sheet2.Range("A2:C11"), 3, 0) Application.EnableEvents = True End If End Sub تقبل تحياتي كابتن ماجد VLOOKUP Formula Change Target Value V2.rar

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