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

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

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

الأفضل في حالة أن الطلب مختلف يفضل طرح موضوع جديد بالطلب الجديد ولن يتأخر من لديه علم بتقديم المساعدة المطلوبة

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

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

الموضوع مكرر ................

وعليكم السلام جرب الكود التالي Sub Test() Dim sh As Worksheet Dim iRow As Long iRow = 1 'Start Row Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Name <> "Sheet1" Then If sh.Range("B2").Value <> "" Then Sheets("Sheet1").Range("A" & iRow).Value = sh.Range("B2").Value iRow = iRow + 1 End If End If Next sh Application.ScreenUpdating = True End Sub

جرب الكود التالي Sub Test() Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim str As String arr = Range("A1:P" & Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim temp(1 To UBound(arr, 1) - 1, 1 To 2) For i = 2 To UBound(arr, 1) str = "" temp(i - 1, 1) = arr(i, 1) For j = 2 To UBound(arr, 2) If arr(i, j) = "X" Then str = str & ", " & arr(1, j) End If Next j temp(i - 1, 2) = Mid(str, 3, Len(str)) Next i Range("R1").Resize(1, 2).Value = Array("Code", "Items") Range("R2").Resize(UBound(temp, 1), 2).Value = temp End Sub

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

وعليكم السلام يااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااااه يا أخ أيسم لكم اشتقنا لك ولمشاركاتك الرائعة بالمنتدى ، الحمد لله أنك بخير دمت بود ، وتقبل وافر تقديري واحترامي

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

حدد على كل خلايا ورقة العمل ثم على رؤوس الأعمدة الظاهرة اعمل كليك يمين ثم Unhide

يمكن أن يكون بهذا الشكل في النهاية Private Sub CommandButton1_Click() Dim fromS As Integer, toS As Integer, end_p As Integer fromS = TextBox1.Value toS = TextBox2.Value If fromS > toS Then MsgBox "تأكد من الإدخالات" Else For end_p = fromS To toS Range("O1").Value = end_p Sheets("Certificates").PrintOut Copies:=1, Collate:=True Next end_p TextBox1 = "": TextBox2 = "" MsgBox "تمت الطباعة المحددة" End If End Sub Private Sub CommandButton2_Click() MZM_CERTIFICATES.Hide End Sub أحب الإعلان عن المتغيرات (يعتبرها المبرمجون عادة حسنة) ..أرجو ألا تنزعج من مناقشتي للكود ، فإنني إذا أعجبني كود أحب دراسته بشكل مفصل تقبل تحياتي

اخي الحبيب محمد الدسوقي أنت قديم بالمنتدى وتعرف الشروط ، الأفضل دائماً أن يكون هناك طلب واحد لكل موضوع حتى يسهل على الباحث فيما بعد أن يجد بغيته فيما يخص طباعة كل الشهادات مرة واحدة يمكن الاعتماد على نفس الكود ، حيث يتم تصدير كافة أوراق العمل إلى مصنف جديد قم بإضافة سطر يطبع المصنف الجديد بالكامل ..يمكن الحصول عليه بتسجيل ماكرو لتعرف كيف يمكنك طباعة مصنف بالكامل ، وتقوم بحذف السطر الذي يقوم بعملي التصدير .. وأعتقد الفكرة كافية جداً أما فيما يخص الفورم : فإذا حضر الماء بطل التيمم ، قام أخونا الغالي محمود بالأمر وتقبلوا وافر تقديري واحترامي أخي الحبيب محمود بعد الإطلاع على الفورم الجميل الذي قمته بعمله ، رأيت سطر الحلقة التكرارية بهذا الشكل For end_p = 1 To Page_p لما لا تبدأ الحلقة التكرارية بقيمة المتغير FromS بشكل مباشر وتنتهي بالمتغير ToS ، وفي هذه الحالة لن يكون هناك داعي لهذا السطر FromS = FromS + 1 حيث ستكون قيمة العداد في الحلقة التكرارية تساوي Froms ، ومن ثم يتم تعديل المتغير في هذا السطر Range("MZM_P_C") = FromS ليكون بهذا الشكل Range("MZM_P_C") = end_P وأيضاً لن يكون هناك داعي في هذه الحالة لهذين السطرين Page_p = ToS - FromS + 1 end_p = 0 تقبل وافر تقديري واحترامي

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

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

أخي الكريم عادةً لا يلتفت للطلبات في المشاركات الفرعية قم بطرح موضوع مستقل لطلبك

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

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

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

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل وافر تقديري واحترامي

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات

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

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

الأخ الكريم خالد أعتذر للتأخير في الرد ، فأنت تعلم أن لكل منا ما يشغله جرب الكود التالي عله يفي بالغرض (لا حاجة لفتح المصنفات الأخرى سيقوم الكود بفتحها ثم يجلب البيانات المطلوبة ويغلقها) Sub CopyFromClosedWorbooks() Dim wb As Workbook Dim folderPath As String Dim fileName As String Dim counter As Double Dim i As Integer Dim lr As Long folderPath = "D:\Data\" fileName = Dir(folderPath & "*.xlsx") Application.ScreenUpdating = False Application.Calculation = xlManual Do While fileName <> "" If fileName <> ThisWorkbook.Name Then Set wb = Workbooks.Open(folderPath & fileName) With ThisWorkbook.Sheets("احصائية المدارس") lr = .Cells(Rows.Count, 6).End(xlUp).Row + 1 .Range("B" & lr).Resize(1, 16).Value = wb.Worksheets(1).Range("B4:Q4").Value End With wb.Close SaveChanges:=False End If fileName = Dir() Loop Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "Done ...", 64 End Sub