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

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

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

بارك الله فيك أستاذي ومعلمي أبو تامر أكواد وحلول في منتهى الروعة

لا داعي للاعتذار أستاذي الفاضل .. زيادة الخير خيرين .. وهذا إثراء للموضوع ليستفيد الجميع

بارك الله فيك أستاذنا الكبير أبوتامر يوجد كود لا يستلزم استدعاء API .. Sub Test_GetOpenFilename() ' ChDir ThisWorkbook.Path PicList = Application.GetOpenFilename(FileFilter:="Picture Files (*.jpg;*.gif;*.png;*.bmp;*.tif;*.Emf;*.jpeg;*.GIF),*.jpg;*.gif;*.png;*.bmp;*.tif;*.Emf;*.jpeg;*.GIF", Title:="Please Choose An Image", MultiSelect:=True) ' End Sub

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

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

جرب الكود التالي في حدث المصنف Private Sub Workbook_Open() Dim Answer As Integer Answer = MsgBox("Do You Want To Continue", vbYesNo + vbQuestion, "YasserKhalil") If Answer = vbYes Then MsgBox "Welcome To Officena", 64 ElseIf Answer = vbNo Then MsgBox "You Cancelled Opening Workbook. Goodbye", vbExclamation ThisWorkbook.Close False End If End Sub

أخي الحبيب محمد الريفي بارك الله فيك وجزاكم الله خيراً .. موضوعاتك دائماً في تألق وبهاء

بارك الله فيك أخي العزيز محي الدين وجزيت خيراً في السطر التالي Sheets.Add After:=Sheets("sheet3") أي أنك حددت إضافة الورقة الجديدة بعد Sheet3 .. وعادةً ما يستحب إضافة أوراق العمل الجديدة بعد نهاية أوراق العمل .. فيرجى التعامل في السطر بعد علامة يساوي لتتمكن من الإضافة بعد آخر ورقة عمل .. هذه نقطة .. ونقطة أخرى ماذا لو تم إدخال حروف تصل إلى أكثر من 31 حرف .. أو تم إدراج حروف خاصة مثل الباك سلاش \ ... حاول التعديل على الكود ليكون شامل وفقك الله لما يحب ويرضى

جرب تغير علامة أكبر من في السطر المشار إليه باللون الأصفر بهذه العلامة <> أي علامة لا تساوي حيث أنه لا توحد مقارنة بين قيمة خلية والفراغ (أكبر من وأصغر من غير مقبولة) .. ولكن يمكن استخدام علامة لا تساوي تقبل تحياتي

قد يكون هناك كودمسئول عن عملية المسح للأكواد والمعادلات .. أو قد يكون العيب في لوحة المفاتيح لديك .. ممكن يكون فيها بعض الأزرار معلقة فتسبب المشكلة .. لا أستطيع الجزم بشيء مؤكد فكلها مجرد احتمالات ..

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

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

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

وعليكم السلام ورحمة الله وبركاته أخي الكريم جلال محمد طالت غيبتك عن المنتدى ولا نراك إلا نادراً .. هل تحب الصيد أم تفضل السمك جاهز ؟ العمل على ملفك قد يستغرق بعض الوقت ففكرت أن أهديك طريقة الحل وليس الحل بالكامل وإن شاء الله ستتمكن من تكملة المشوار بنفسك .. سنأخذ مثال واحد فقط ونطبق عليه الكود : في ورقة الإحصاء في العمود الأول المطلوب إحصاء الذكور فالمعادلة التي يمكن استخدامها ببساطة باستخدام الدالة SUMPRODUCT ستكون بالشكل التالي =SUMPRODUCT(--(Total!$CJ$13:$CJ$146="ذكر")) سنقوم بوضع الكود التالي في موديول وسأشرح لك الأجزاء المهمة لتستطيع تنفيذ المهمة (شفت الجناس التام بين كلمة المهمة الأولى وكلمة المهمة الثانية ..مش موضوعنا) Sub Ehsaa_Using_VBA() Dim Ws As Worksheet Dim Sh As Worksheet Dim LR As Long Set Ws = Sheets("Total") Set Sh = Sheets("احصاء بالكود") 'متغير لمعرفة آخر صف فيه بيانات في ورقة العمل الأساسية LR = Ws.Range("C" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False With Sh.Range("C9:C24") .Formula = "=SUMPRODUCT(--(Total!$CJ$13:$CJ" & LR & "=""ذكر""))" .Value = .Value End With Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub الكود في أوله شوية متغيرات وبعدين بنرمز لورقة العمل الأساسية بالرمز Ws وورقة العمل إحصاء بالرمز أو المتغير Sh .. بنحدد آخر صف فيه بيانات من خلال الكود .. ودا الفرق بين المعادلة والكود .. في المعادلة بنحدد آخر النطاق بأنفسنا لكن هنا في الكود هنخلي الإكسيل هو اللي يحدد آخر صف ودا هيكون بناءً على عمود الأسماء اللي هو العمود C أو العمود الثالث نيجي بقا للجزء المهم اللي من خلاله هنقدر نتعامل مع النطاق C9:C24 (العمود الأول في الإحصاء) كل الفكرة إننا هنضع المعادلة بس في الكود وبعدين نحول المعادلة لقيمة للتخلص من المعادلة والإبقاء على القيمة (ودا بيخفف من حجم الملف) With Sh.Range("C9:C24") .Formula = "=SUMPRODUCT(--(Total!$CJ$13:$CJ" & LR & "=""ذكر""))" .Value = .Value End With إزاي نتعامل .. أولاً بنحدد النطاق في السطر الأول اللي هنضع فيه المعادلات ودي أمرها بسيط النقطة الأهم إزاي نعدل المعادلة في الكود .. فيه شوية حاجات لازم تاخد بالك منها أول حاجة الفاصلة المنقوطة في المعادلة بتحولها لفاصلة عادية .. تاني حاجة المعادلة كلها توضع بين أقواس تنصيص بعد علامة يساوي اللي بعد كلمة Formula النصوص بتوضع بين أقواس تنصيص مرتين .. يعني مثلا كلمة ذكر في المعادلة وضعنا قوس تنصيص قبلها وقوس تنصيص بعدها ، أما داخل الكود هنخلي أقواس التنصيص مرتين قبلها ومرتين بعدها آخر حاجة بنعملها إننا بنشيل رقم آخر صف اللي هو في المعادلة الرقم 146 ونضع مكانه المتغير LR (اللي بيمثل رقم آخر صف داخل الكود) يعني شيل الرقم 146 من المعادلة وضع مكانها " & LR & " .... قم بتكرار نفس الأسطر الأربعة المشروحة لك مع بقية المعادلات مع تغيير النطاق وتغيير المعادلات وغير ما يلزم .. أرجو أن تكون الصورة واضحة لك .. وإن شاء الله تفلح في تكملة الحل .. واعذرني لأنني لا أقدم الحلول جاهزة كبقية الأخوة في المنتدى (هذا في رأيي الشخصي أفضل وأوفر للوقت والجهد ..) تقبل تحياتي

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

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

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

بارك الله فيك أخي الحبيب سليم على الملف الجميل والحل الرائع وعلى إثراء موضوع قيم

أخي الكريم منير أهلاً بك في المنتدى ونورت بين إخوانك برجاء تغيير اسم الظهور للغة العربية ، والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى في انتظار الملف المرفق إن شاء الله .. عموماً جرب المرفق التالي عله يكون المطلوب إن شاء المولى Private Sub Worksheet_Change(ByVal Target As Range) Dim Sh As Worksheet Set Sh = Sheet2 Sh.Cells(Target.Row, Target.Column).Value = Target.Value End Sub تقبل تحياتي Change Cells Values In Another Sheet Worksheet Change YasserKhalil.rar

أخي الكريم مشعل أهلاً بك في المنتدى ونورت بين إخوانك يرجاء تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى بالنسبة لطلبك يوجد خيار في خيارات الإكسيل يمكن من خلاله أن تحدد مدة الحفظ التلقائي وأقل مدة يمكن تحديدها دقيقة واحدة فقط وأعتقد أنها مدة لا بأس بها أما إذا أردت الحفظ كل 5 ثواني فإليك الطريقة ضع الكود التالي في حدث المصنف ThisWorkbook Module Private Sub Workbook_Open() Call Save_Workbook End Sub ثم ضع الكود التالي في موديول عادي Public Sub Save_Workbook() Dim currentTime As Date Const Sec = 5 ThisWorkbook.Save currentTime = DateAdd("S", Sec, Now) Application.OnTime currentTime, "Save_Workbook" End Sub غير الرقم 5 والذي يمثل الثواني للرقم المطلوب الآن قم بحفظ المصنف وأغلقه وأعد فتحه وجرب بنفسك

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

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

وجزيت خيراً أخي الكريم حسين بمثل ما دعوت لنا