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

تمام يا عدوي (مش يا عدوي ..) لأنها تفرق كتير .. وإنت إن شاء الله من الأصدقاء وليس الأعداء تقبل تحياتي

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

أخي الكريم عاشق الإكسيل يبدو أن أخونا الحبيب أبو عيد منشغل عنا .. فإليك التعديل في الكود مع شرح لأسطر الكود ليمكنك التعديل عليه بما يناسب ملفك الأصلي Sub RecallDataEid() 'يقوم الكود باستدعاء بيانات الأذون من ورقة الأرشيف بناءً على رقم الإذن '------------------------------------------------------------------ 'تعريف المتغيرات المستخدمة في الكود Dim A As Integer, LR As Long, LR1 As Long, R As Integer, T As Integer 'شرط لاختبار وجود خطأ في حالة عدم وجود رقم الإذن 'وتتم عملية البحث في ورقة الأرشيف في النطاق المحدد [M5] يتم البحث عن رقم الإذن الموجود في الخلية If IsError(Application.Match([M5].Value, Sheets(3).[A1:A2000], 0)) Then 'إظهار رسالة للمستخدم في حالة عدم وجود رقم الإذن والخروج من الإجراء الفرعي If MsgBox("رقم الإذن غير موجود" & vbCrLf & "هل تريد مسح بيانات الإذن الموجودة؟", vbYesNo + vbExclamation) = vbYes Then Range("B20:K33") = "": Range("C10,C12,C16") = "" End If Exit Sub Else 'إلغاء تحديث الشاشة أثناء عمل الكود لتسريع الكود Application.ScreenUpdating = False 'تعيين قيمة للمتغير ليساوي رقم الصف الموجود فيه رقم الإذن في ورقة الأرشيف A = Application.Match([M5].Value, Sheets(3).[A1:A2000], 0) 'الحصول على رقم آخر صف في ورقة الأرشيف في عمود التوجيه المحاسبي LR = Sheets(3).Range("I" & Rows.Count).End(xlUp).Row + 1 'تعيين قيمة المتغير ليساوي 20 وهو يمثل رقم أول صف سيتم وضع بيانات الإذن فيه R = 20 'مسح النطاق الذي ستوضع فيه بيانات الإذن [B20:K33] = "" 'الحصول على رقم آخر صف يلي الصف الذي يطابق رقم الإذن 'أي آخر صف لنفس الإذن المطابق لرقم الإذن بحيث يتم جلب جميع بيانات الإذن LR1 = Sheets(3).Range("A" & A).End(xlDown).Row 'في حالة أن المتغير أكبر من أو يساوي آخر صف في ورقة العمل 'يتم تعيين قيمة المتغير ليساوي رقم آخر صف بناءً على عمود التوجيه المحاسبي If LR1 >= Rows.Count Then LR1 = LR 'حلقة تكرارية بدايةً من الصف الذي يقع فيه رقم الإذن في ورقة الأرشيف 'إلى آخر صف في العمود الأول بعد الصف المطابق لرقم الإذن في ورقة الأرشيف For T = A To LR1 - 1 'كبداية الحلقة تساوي الخلية في العمود الثامن في ورقة الأرشيف [B20] الخلية 'في نفس الصف الذي يطابق رقم الإذن ، فلو كان رقم الإذن = 2 فالصف سيكون 5 Range("B" & R) = Sheets(3).Range("G" & T).Value 'نفس السطر السابق وينطبق على عمود الدائن Range("D" & R) = Sheets(3).Range("H" & T).Value 'نفس السطر السابق وينطبق على عمود التوجيه المحاسبي Range("F" & R) = Sheets(3).Range("I" & T).Value 'زيادة رقم صف البداية والذي كان يساوي 20 بمقدار 1 استعداداً للحلقة التالية R = R + 1 'الانتقال للحلقة التالية Next T 'الخلية تساوي الاسم الموجود في عمود المستفيد في نفس صف رقم الإذن [C10] = Sheets(3).Range("D" & A).Value 'الخلية تساوي الاسم الموجود في عمود المناولة في نفس صف رقم الإذن [C12] = Sheets(3).Range("E" & A).Value 'الخلية تساوي الاسم الموجود في عمود البيان في نفس صف رقم الإذن [C16] = Sheets(3).Range("F" & A).Value 'إعادة تفعيل تحديث الشاشة Application.ScreenUpdating = True End If End Sub أرجو أن يفي بالغرض .. تقبل تحياتي

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

وجزيت خيراً بمثل ما دعوت أخي الفاضل محمود محمد عبد الستار والحمد لله أولاً وأخيراً ..الحمد لله ملء السماوات وملء الأرض وملء ما بينهما وملء ما شئت من شيءِ بعد تقبل تحياتي

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

إن شاء الله سأحاول فيه غداً .. ربنا ييسر الأمور معادلة لا تفي بالغرض بشكل كلي لكنها حل مبدئي .. في الخلية E2 ضع المعادلة التالية =COUNTIF(Data!$A$2:A2,A2) وضع المعادلة التالية في الخلية B2 ستعطيك مزيد من النتائج الصحيحة ولكن ليس للكل بالطبع ..فهو حل بشكل مبدئي إلى أن يتدخل أحد الأخوة المختصين بالمعادلات لحل الإشكالية =IF(E2=0,"",IF(E2=1,IFERROR(VLOOKUP(A2,Data!$A$2:$B$8,2,FALSE),""),IF(E2=2,LOOKUP(2,1/(Data!$A$2:$A$8=A2),Data!$B$2:$B$8),IF(E2>2,">2","")))) تقبل تحياتي

أخي الكريم يرجى تغيير اسم الظهور للغة العربية جرب البرنامج التالي http://www.mediafire.com/download/5e6wvow1bx2busx/FileFormatConverters.rar

الحمد لله أن تم المطلوب على خير والفضل لله عزوجل ثم لأخونا أبا الحسن والحسين .. الحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي

نعم أخي الكريم أبو حماده يوجد كود يمكنك من خلاله تغيير وقت الجهاز .. ولكن ما هي الخلية التي سيتم فيها كتابة الوقت المراد التغيير إليه ..أو كيف ستغير وقت الجهاز ..على أي أساس؟

حسناً أخي الفاضل أبو مهند بقيت نقطة أخيرة للتوضيح ..في حالة أن الموظف تكرر لمرة واحدة فقط ..ما هو المنطق الذي يحدد إذا ما كان هذا هو وقت الحضور أو الانصراف ؟ ونفس السؤال في حالة تكرر الموظف أكثر من مرتين ..ما هو المنطق في اختيار أوقات الحضور والانصراف؟

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

أخي الكريم المتأمل جرب الكود التالي في حدث ورقة العمل ..كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code ثم الصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Column = 10 And Target.Row > 5 Then Application.ScreenUpdating = False Application.EnableEvents = False Dim Stock, Suggested With Target Stock = .Offset(, -5): Suggested = .Offset(, -3) If Stock = Suggested Then If InStr(.Value, "دفع") > 0 Then MsgBox "الرصيد يساوي المبلغ المقترح", 64: .ClearContents: .Activate If Stock <> Suggested Then If InStr(.Value, "سداد") > 0 Then MsgBox "يمنع كتابة كلمة سداد حيث أن الرصيد والمقترح غير متساوين", 64: .ClearContents: .Activate End With Application.ScreenUpdating = True Application.EnableEvents = True End If End Sub أرجو أن يكون المطلوب ويفي بالغرض تقبل تحياتي

أخي الكريم محمد الملف يعمل بشكل عادي معي ..قد تكون المشكلة في نسخة الأوفيس لديك جرب تحمل نسخة أوفيس أحدث إصدار وليكن 2013 أو 2016 ..

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

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

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

تمام كدا وضحت الفكرة ..إذاً ضع هذا السطر في الكود ليختفي التطبيق ثم تظهر الرسالة في حالة عدم التطابق لمسار الملف مع مسار الملف الموجود في الكود Private Sub Workbook_Open() Dim KHM As String Application.Visible = False KHM = Trim(Sheets("Sheet1").Range("A1")) Dim MyPath As String '************************************************************************************* '''''''' KHMB.xls ويوضع داخله ملف الإكسل KHMB وإسم المجلد D:\ هنا إسم المسار في الدرايف MyPath = "D:\KHMB" '************************************************************************************* If ThisWorkbook.Path <> MyPath Then MsgBox "مسار الملف" & vbNewLine & "تم تغيير مسار الملف ولن يعمل معك إلاً من مسارة الصحيح" 'Application.DisplayAlerts = False Application.Quit Else MsgBox MyPath End If Dim MyFlName As String '************************************************************************************* ''''''' D:\ في الدرايف KHMB وهنا إسم ملف الإكسل يتم وضعة داخل المجلد MyFlName = KHM '************************************************************************************* If ThisWorkbook.Name <> MyFlName Then MsgBox "إسم الملف" & vbNewLine & "لقد تم تغيير إسم الملف ولن يفتح معاك إلاً بإسمة" 'Application.DisplayAlerts = False 'ThisWorkbook.Close Else MsgBox KHM End If End Sub أضفت السطر الذي ذكرته في بداية الكود ..وأضفت سطر لإغلاق التطبيق ككل وليس المصنف فقط بعد الرسالة في حالة عدم التطابق تقبل تحياتي

=IFERROR(VLOOKUP(A2,البيانات!$A$2:$B$8,2,FALSE),"") أخي الكريم أبو مهند بالنسبة للخطأ الموجود في الخلية B6 التي بها المعادلة التالية يمكن تجنبها باستخدام الدالة IFERROR أي في حالة حدوث خطأ ..استبدل المعادلة الموجودة في الخلية B2 بهذه المعادلة ثم قم بسحبها =VLOOKUP(A6,البيانات!$A$2:$B$8,2,FALSE) أعتقد أن هذا ليس المطلوب ولكنه بداية لنقطة سألت عنها ..فيما يخص طلبك ما هي شكل النتائج المتوقعة ..أرى أنك حللت الخطأ ولكن ما هو المنطق المتبع لتصحيح الأخطاء وما هي شكل النتائج المتوقعة كي نستطيع تقديم المساعدة تقبل تحياتي

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

أخي الكريم محمد الزريعي ارفق ملفك للإطلاع عليه .. تقبل تحياتي

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

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

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

جرب تغير السطر الخاص بتحديد رقم العمود إلى الشكل التالي If Target.Column = 5 Or Target.Column = 9 Or Target.Column = 13 Or Target.Column = 17 Or Target.Column = 21 And Target.Row > 4 Then حيث الرقم 5 يشير إلى العمود الخامس E والرقم 9 يشير إلى العمود التاسع I وهكذا ..بحيث يمكنك التعامل مع هذه الأعمدة فقط