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

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

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

غير اسم الماكرو الجديد دي أول ملحوظة لاحظتها بعد تنزيل ملفك مينفعش يكون فيه 2 ماكرو بنفس الاسم .. اجعل اسم الماكرو الجديد باسم InsertPictureVBA2 مثلاً روح اعمل كليك يمين على اسم ورقة العمل "بطاقة الموظف" ثم View Code ثم عدل الكود الموجود ليكون بهذا الشكل ليتم تنفيذ الكود بمجرد التغير في الخلية B3 Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B3")) Is Nothing Then Z = Application.CountA(Sheets("الشهر الاول").Range("A2:A300")) For I = 2 To Z + 2 If Target.Value = Sheets("الشهر الاول").Cells(I, 1).Value Then Target.Offset(0, 2).Value = Sheets("الشهر الاول").Cells(I, 2).Value End If Next I Call InsertPictureVBA2 End If End Sub جرب أعملني بالنتيجة

كليك يمين على الفورم ثم الأمر View Code للإطلاع على الكود

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

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

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

السطر التالي يحدد مسار مجلد الصور strPhotosFolder = ThisWorkbook.Path & "\صور\" ************************************* السطر التالي With Sheets("بطاقة الموظف السنوية") يحدد ورقة العمل المطلوب العمل عليها *************************************** السطر التالي strPhoto = strPhotosFolder & Trim(.Range("B2").Value) & ".*" غير اسم الخلية B2 باسم الخلية اللي فيها رقم الموظف (التي يتم كتابة رقم الموظف بها) ************************************* الأسطر التالية .Left = .Parent.Range("J1").Left .Top = .Parent.Range("J1").Top .Width = .Parent.Range("J1").Width .Height = .Parent.Range("J1").Height هتغير اسم الخلية التي يوضع بها الصور J1 إلى الخلية التي تريد إدراج الصورة بها بس خلاص الموضوع بسيط مش معقد أخي الفاضل أبو زيد

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

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

ها هي المشكلة التي وضعت يدي عليها ... الملف المرفق في المشاركة رقم 3 غير معبر عن الملف الأصلي .. يبدو أن الخلية التي تحتوي على التاريخ منسقة بشكل مختلف عموماً جرب الكود بهذا الشكل وإن شاء الله تنحل مشكلتك Sub CreateBackup() ThisWorkbook.SaveCopyAs Filename:="D:\" & Range("E5").Value & "_" & Replace(Format(Range("E3"), "yyyy/mm/dd"), "/", "_") & ".xlsm" End Sub

لا أدري ما سبب الخطأ قد يكون السبب في اختلاف إصدار الأوفيس .. أنا أعمل على أوفيس 2013 والكود يعمل بشكل ممتاز .. ننتظر تجربة الأعضاء للكود فلربما تكون المشكلة في الملف الأصلي لديك

أخي الكريم المهاجر يرجى مراجعة رابط التوجيهات وتغيير اسم الظهور للغة العربية إليك الكود التالي يوضع في حدث المصنف بفرض أن لديك ورقة عمل باسم SaveInf والتي سيتم تسجيل المعلومات الخاصة بالحفظ داخلها .. التاريخ والوقت وورقة العمل النشطة التي تمت عملية الحفظ فيها واسم المستخدم الذي قام بعملية الحفظ وعدد مرات الحفظ .. أرجو أن يكون المطلوب Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) With ThisWorkbook.Sheets("SaveInf") If Application.CountA(.Range("A1:C1")) = 0 Then .Range("A1:C1").Value = Array("اسم المستخدم", "ورقة العمل أثناء الحفظ", "وقت عملية الحفظ") With .Range("A" & Rows.Count).End(xlUp)(2) .Resize(, 3).Value = Array(Application.UserName, ActiveSheet.Name, Now) With .Offset(1, 2) .FormulaR1C1 = "=COUNT(R2C:R[-1]C)&"" إجمالي مرات الحفظ""" End With End With End With End Sub لا تنسى أن تحدد أفضل إجابة كما لا تنسى أن تضغط "أعجبني هذا" إذا أعجبك المحتوى والكود تقبل تحياتي :fff: Save Process History YasserKhalil.rar

أخي الفاضل أبو زيد ... السلام عليكم إليك الكود التالي وإن شاء الله بإذن المولى يفي بالغرض تماماً .. Sub InsertPictureVBA() Dim pic As Picture, strPhotosFolder As String, strPhoto As String strPhotosFolder = ThisWorkbook.Path & "\صور\" Application.ScreenUpdating = False With Sheets("بطاقة الموظف السنوية") While .Pictures.Count .Pictures(1).Delete Wend strPhoto = strPhotosFolder & Trim(.Range("B2").Value) & ".*" strPhoto = Dir(strPhoto) If Len(strPhoto) Then strPhoto = strPhotosFolder & strPhoto .Pictures.Insert (strPhoto) Set pic = .Pictures(.Pictures.Count) With pic .ShapeRange.LockAspectRatio = msoFalse .Left = .Parent.Range("J1").Left .Top = .Parent.Range("J1").Top .Width = .Parent.Range("J1").Width .Height = .Parent.Range("J1").Height End With End If End With Application.ScreenUpdating = True End Sub كل ما عليك فعله هو تغيير مسار مجلد الصور من هذا السطر strPhotosFolder = ThisWorkbook.Path & "\صور\" ليصبح بهذا الشكل strPhotosFolder = "D:\صور\" كما تمت إضافة سطر في حدث الورقة المسماة "بطاقة الموظف السنوية" ليتم تنفيذ الكود بمجرد التغير في الخلية B2 ... قم بكتابة رقم الموظف لتظهر الصورة الخاصة به في الخلية J1 بنفس الأبعاد للخلية .. الملفات في مجلد الصور تكون بأرقام الموظفين .. كل موظف له صورة مسماة برقمه أو يمكنك التعديل في الكود بما يحلو لك ... ليناسب طلبك أياً كان تقبل الله منا ومنكم صالح الأعمال ولا تنسى أن تحدد أفضل إجابة كما لا تنسى أن تضغط أعجبني هذا إذا أعجبك بالطبع برنامج البطاقة الشهرية والسنوية.rar

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

تفضل أخي الكريم الملف التالي عله يفي بالغرض قم بتغيير المسار في الخلية J1 برنامج بطاقة الموظف الشهري والسنوي.rar

أخي الكريم أبا إسماعيل .. هل اطلعت على الفيديو الرائع للأخ المتميز إسلام رجب قمت بتنفيذ الكود الموجود في الفيديو مع الإضافات البسيطة اللازمة لتوافق طلبك جرب الكود بهذا الشكل Sub CreateBackup() ThisWorkbook.SaveCopyAs Filename:="D:\" & Range("E5").Value & "_" & Replace(Range("E3"), "/", "_") & ".xlsm" End Sub

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

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

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

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

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

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

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

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