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

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

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

أخي الكريم مرسال يرجى تغيير اسم الظهور للغة العربية .. قمت بتغيير شكل الملف قليلاً لسهولة التعرف على كيفية التعامل مع البيانات بشكل صحيح .. لأن الملف المرفق من قبلك غير معبر بعض الشيء عموماً يمكنك التعديل بسهولة على الملف وعلى الكود يوضع الكود في حدث ورقة العمل المسماة Sheet1 .. كليك يمين على اسم ورقة العمل Sheet1 ثم اختر الأمر View Code ثم الصق الكود التالي ..ثم انقر دبل كليك في عمود الاسم ليتم إعداد التقرير للاسم الذي قمت بالنقر عليه دبل كليك وإذا كانت الخلية فارغة يتم مسح محتويات التقرير Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Column = 3 And Target.Row > 3 Then Application.ScreenUpdating = False Application.EnableEvents = False Cancel = True Dim Sh As Worksheet, lRow As Long Set Sh = Sheets("التقرير") lRow = Target.Row With Sh .Range("D5,D7,H8,H11,D11").Value = "" If Not IsEmpty(Target) Then .Range("D5").Value = Date .Range("D7").Value = Cells(lRow, "C").Value .Range("H8").Value = Cells(lRow, "D").Value .Range("H11").Value = Cells(lRow, "E").Value .Range("D11").Value = Cells(lRow, "F").Value MsgBox "تم إعداد تقرير للموظف " & Cells(lRow, "C").Value & " في ورقة التقرير", 64 End If End With Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub تقبل تحياتي Single Report For Each Name Worksheet Double Click YasserKhalil.rar

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

بارك الله فيكم إخواني وجزاكم الله خير الجزاء على مروركم العطر بالموضوع

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

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

بارك الله فيك يا ابن الملك على الحل الرائع والبسيط جزيت خيراً .. تقبل تحياتي

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

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

أخي الكريم خالد يرجى للمرة الثانية تغيير اسم الظهور للغة العربية جرب المعادلة التالية =--TRIM(MID(SUBSTITUTE(SUBSTITUTE(TRIM(SUBSTITUTE(A2,CHAR(160)," "))," ","-",2),"-",REPT(" ",50)),50*2,50))

أخي الكريم نايف أعتذر لأنني لم أتابع الموضوع منذ البداية وظننت أن هذا طلب مختلف عموماً حسب ما فهمت من طلبك جرب الكود التالي .سيتم تلوين العمود الخامس المطابق لحدوث الشرط وهو مساواة القيمة للخلية الأولى في ورقة العمل Sub Test() Dim MyRange As Range, Cel As Range, Rng As Range, LastCol As Long Set MyRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1)) For Each Cel In MyRange If Cel.Value = Range("A1").Value Then If Not Cel Is Nothing Then If Rng Is Nothing Then Set Rng = Cel Else Set Rng = Union(Rng, Cel) End If Next Cel Rng.Offset(, 4).Interior.ColorIndex = 6 End Sub

ما رأيك بإرفاق ملف للعمل عليه ولتوضيح المطلوب أكثر؟ إنت المفروض تكون اتعودت على النظام يا أبو حماده

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

أخي الكريم نايف يرجى توضيح الفكرة المطلوبة بشكل أكثر تفصيلاً .. والأفضل لو بملف مرفق

أخي الكريم يرجى تغيير اسم الظهور للغة العربية ضع المعادلة التالية في الخلية B2 =IF(ISNUMBER(SEARCH("USD",A2)),--SUBSTITUTE(RIGHT(TRIM(SUBSTITUTE(A2,CHAR(160)," ")),14),"- USD",""),IF(ISNUMBER(SEARCH("EUR",A2)),--SUBSTITUTE(RIGHT(TRIM(SUBSTITUTE(A2,CHAR(160)," ")),14),"- EUR",""),IF(ISNUMBER(SEARCH("NOK",A2)),--SUBSTITUTE(RIGHT(TRIM(SUBSTITUTE(A2,CHAR(160)," ")),14),"- NOK",""),""))) إذا لم تعمل المعادلة معك قم باستبدال الفاصلة العادية في المعادلة بفاصلة منقوطة

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

أخي الكريم الرسالة مجرد سطر في حالة تحقق الشرط بأن الخليتان غير متساويتان ..يمكنك استبدال السطر بما تشاء من أسطر الكود بالنسبة للنسخ الكود لا يقوم بنسخ التنسيق كما ذكرت ..إنما يتم نسخ القيمة فقط ..(لاحظ أنني لم أستخدم الأمر Copy) وبالتالي عند مساواة قيمة خلية بأخرى فإنه يتم نسخ القيمة فقط بدون تنسيقات أو معادلات أو خلافه .. بالنسبة لتحديد الورقة المطلوب العمل عليها ضع اسم ورقة العمل قبل النطاق ..مثال Sheets("Sheet1").Range ("D5")

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

أخي الكريم أبو حماده جرب الكود التالي (رغم أن نقطة الخروج من الكود غير واضحة ..) يوضع الكود في حدث إغلاق المصنف Private Sub Workbook_BeforeClose(Cancel As Boolean) If Range("B1").Value = Range("B2").Value Then MsgBox "الخليتان متشابهتان", 64: Exit Sub Else Range("D1").Value = Range("D5").Value End If End Sub

أخي الكريم أهلاً بك في المنتدى ونورت بين إخوانك ..(يا ابن ابو حماده) يمكنك طرح موضوع جديد لطلبك حتى تجد استجابة من الأخوة الأعضاء

وجزيت خيراً بمثل ما دعوت وزيادة أبي الغالي أبو يوسف مشكور على مرورك الطيب والعطر

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

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

بارك الله فيك أخي الحبيب بن عليه وجزيت خير الجزاء ولكن لي رأي عند التعامل مع الأكواد أفضل عدم الاعتماد على ورقة العمل .. فيمكن الاستغناء عن العمود المساعد كما يمكن الاستغناء عن النطاقات المسماة والتي أرى أنها من الأسباب التي تثقل من عمل الملف عند الإكثار منها .. فإليك الكود التالي عله يفي بالغرض Sub Insert_HBreaks() Dim I As Integer, Str1 As String, Str2 As String With ThisWorkbook.Worksheets("Sheet1") .ResetAllPageBreaks Str1 = .Range("B2") For I = 2 To .Range("A" & .Rows.Count).End(xlUp).Row Str2 = .Range("B" & I) If Str2 <> Str1 Then .HPageBreaks.Add Before:=.Range("A" & I) Str1 = Str2 End If Next I End With End Sub تقبل وافر تقديري واحترامي