ابو الآء

بارك الله فيك ننتظر الباقى ان شاء الله

بالفعل استاذى وهى بداخل الكود d2 لكن الكود لا يعمل

الف شكر استاذى معلش بقالى مده كبيره بعيد عن المجال وبعدين انا تلميذ لسه مبتدء مش تزعل منى بارك الله فيك

السلام عليكم اليك الملف اخى بعد نقل الكود الى ملفى فى الملف الاصلى عمل معى ولكن نتائج خطاء بعد النقل لا يعمل ايضااا كلمه المرور المستخدم 1 الباص 1 فتح الاكواد 1 ابو القاسم.rar

السلام عليكم اسف اخى حاولت وحظيت رقم الخليه ومش بتدى النتائج المرجوه عاوز استخدم الكود فى عمل بطاقات مدرسية للطلبه على برنامج خاص بي ولم انجح حاول مره كثره المفروص الخليه e3 بيها قائمه منسدله فيها ارقام الفصول ارجوا المساعده

الف مبروووووووووووووووووك تستحق كل الخير وبالمناسبه عاوزين شرح للجداول المحوريه بارك الله فيك

التعديل هناا ' خلية عدد كل المتقدمين Const CountAll As String = "D2" ' خلية عدد الناجحين Const CountNA As String = "ناجح" اريدها هنا الخليه e3 ' كلمة البحث عن الناجحين Const NA_G As String = "F2" ' خلية عدد دور ثاني Const CountDT As String = "H2" ' كلمة البحث عن دور ثاني Const DT_G As String = "دور ثان" '*************************************

السلام عليكم الرجاء التعديل على كود طباعه الشهادات بما يناسب منطلباتى '*********************************************** '*********************************************** ' اسم ورقة الشهادات Const ShName As String = "الشهادة" ' رقم اول صف للشهادة Const FirstRow As Integer = 5 ' عدد صفوف الشهادة Const CountRow As Integer = 13 'عدد اعمدة الشهادة التي تريد اظهارها في الطباعة Const CountColumn As Integer = 20 ' خلية موقع الطالب لمعادلات الشهادة Const Range_Index As String = "B13" '===================================== ' اسم ورقة البيانات Const sh As String = "شيت " ' نطاق ناجح دور ثاني في ورقة البيانات Const MyND As String = "da12:da1000" ' نطاق الاسماء في ورقة البيانات Const MyNSearch As String = "m12:m1000" '===================================== ' خلية عدد كل المتقدمين Const CountAll As String = "D2" ' خلية عدد الناجحين Const CountNA As String = "ناجح" اريدها هنا الخليه e3 ' كلمة البحث عن الناجحين Const NA_G As String = "F2" ' خلية عدد دور ثاني Const CountDT As String = "H2" ' كلمة البحث عن دور ثاني Const DT_G As String = "دور ثان" '************************************************ '************************************************ Dim KH_Test As Boolean Dim MySheet As Worksheet Sub الكل() Application.ScreenUpdating = False kh_ClearContents With MySheet .Range(Range_Index).Value = 1 Call kh_Test_Fill(.Range(CountAll)) If KH_Test Then .PrintPreview Else .Range(Range_Index).ClearContents End With Application.ScreenUpdating = True End Sub Sub الناجحين() Application.ScreenUpdating = False kh_ClearContents With MySheet Call kh_Test_Fill(.Range(CountNA)) If KH_Test Then Call kh_Nd(NA_G): .PrintPreview End With Application.ScreenUpdating = True End Sub Sub دور_ثاني() Application.ScreenUpdating = False kh_ClearContents With MySheet Call kh_Test_Fill(.Range(CountDT)) If KH_Test Then Call kh_Nd(DT_G): .PrintPreview End With Application.ScreenUpdating = True End Sub Sub Item_Search() Dim NN As Integer, R As Integer, C As Integer, RR As Long NN = form_Search.CM_ListAdd.ListCount Application.ScreenUpdating = False kh_ClearContents With MySheet If NN = 1 Then .Range(Range_Index).Value = form_Search.CM_ListAdd.List(0, 1) Else Call kh_AutoFill(NN) RR = .Range(Range_Index).Row C = .Range(Range_Index).Column For R = 0 To NN - 1 .Cells(RR, C) = form_Search.CM_ListAdd.List(R, 1) RR = RR + CountRow Next End If .PrintPreview End With Unload form_Search Application.ScreenUpdating = True End Sub Sub kh_Test_Fill(MyCel As Range) If IsNumeric(MyCel) And MyCel.Value > 0 Then KH_Test = True If MyCel.Value <> 1 Then Call kh_AutoFill(MyCel.Value) Else KH_Test = False MsgBox MyCel.Offset(0, -1) & Chr(10) & Chr(10) & MyCel, 524288 + 1048576 + 16, "بيانات غير متوفرة" End If End Sub Sub kh_AutoFill(R As Integer) Dim SourceRange As Range, fillRange As Range Dim RR As Long RR = (R * CountRow) With MySheet Set SourceRange = .Rows(FirstRow).Resize(CountRow) Set fillRange = .Rows(FirstRow).Resize(RR) SourceRange.AutoFill fillRange, xlFillDefault .PageSetup.PrintArea = .Range("B" & FirstRow).Resize(RR, CountColumn).Address End With End Sub Sub kh_Nd(Nd As String) Dim MyRng As Range Dim R As Integer, C As Integer, RR As Long Set MyRng = Sheets(sh).Range(MyND) With MySheet RR = .Range(Range_Index).Row C = .Range(Range_Index).Column End With With MyRng For R = 1 To .Rows.Count If .Cells(R, 1) = Nd Then MySheet.Cells(RR, C) = R RR = RR + CountRow End If Next End With End Sub Sub kh_ClearContents() Dim T As Long Set MySheet = Sheets(ShName) With MySheet .Range(Range_Index).ClearContents T = .UsedRange.Rows.Count .Rows(FirstRow + CountRow).Resize(T).Delete Application.GoTo .Range(Range_Index), True End With End Sub Sub kh_Delete() Application.ScreenUpdating = False kh_ClearContents Application.ScreenUpdating = True ThisWorkbook.Save MsgBox "تم مسح الشهادات وحفظ العمل", vbMsgBoxRight, "الحمد لله" End Sub Sub معاينة() ورقة4.PrintPreview End Sub Sub Kh_Search() Load form_Search With form_Search .Tag = sh .CM_TextFind.Tag = MyNSearch .Show End With End Sub

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

تفضل اخى الملف سيد.rar

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

استاذى الفاضل YasserKhalil بارك الله فيك استاذى الفاضل سليم حاصبيا بارك الله فيك عاوزين شرح للحلول اخى سليم الحل بتاع حضرتك ينفع فى تحديد مدى للطباعه حسب البيانات

السلام عليكم اسف استاذ ياسر بس اتحملنى شويه انا مثلا عندى شيت معين لادخال البيانات فيه نطاقات معرفه مثلا data النطاق ده من a8:k100 وجواه مده معين او معرف مثلا sa من a1:a100 ممكن بالكود النطاق بمحتواه يذيد مع ذياده البيانات يعنى كل ما ادخل بيانات ذياده المدى يذيد معاها

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

اخى على حد علمى هذا ليس ترحيل ولكن استدعاء للمعلومات وهناك اكير من طريقه اولا عن طريق المعادلات العاديه ثانيا عن طريق معادلات الصفيف ثالثا عن طريق الفلتره رابعا عن طريق الكوووووود وفكره صفوف فارغه عادى جدااا تقدرتنسخ الشيت لشيت جديد وتدرج صفوف فارغه بين كل صف واخر ولكى اج انه ليس لها اى داعى حدد طلباتك فى الملف وارفعه واللى اقدر افيدك بيه هعمله خالص تحياتى

السلام عليكم حاولت على قدر ما افتكرت لانى بقالى مده بره المجال لو اللى عملته على الطريق اللى ينفعك نكمل ان شاء الله Copy of كنترول 2015.rar

بارك الله فيك ان شاء الله بعد الفحص الكامل لنا عوده فى التعليقات

قبل التجربه عمل رائع من شخص رائع بارك الله فيك ولنا لقاء بعد التجربة والتعلم

اساتذتى الكبار اسف جداا على عدم الرد فى وقتها بسبب وجود مشاكل خاصه مع مشاكل الانترنت لذلك اقدم لكم شديد اسفى وتقديرى العظيم لمجهوداتكم الكبيرة بارك الله فيكم

اسف على تأخرى فى الرد استاذى الكبير بسبب ظروف النت سوف اقوم بتحميل الملف ونقل الكود للملف الكامل والتجريب بامر الله سوف اقوم بالرد بعد التجريب اسف للمره الثانيه لان النت لدى وحش جدا

استاذى الفاضل شرف كبير لى مرور على موضوعى اولا الحل الذى تفضلت به جميل جدا ولكن فى الملف الكامل يوجد اكثر من 30 شيت يعتمد على نفس المعادله ولكن فى تغيير فى العمود المراد البحث فيه والملف اصبح ثقيل جدااا وبعض المادرس التى تعمل على الملف عدد الطلبه كبير جداا وبذلك حم الملف قد يصل فى بعض الاحيان الى 50 ميجا ويصبح ثقيل جداا فى الفتح والماعدلات تحسبب ببطء شديد وكنت قد نويت ان اقوم باستخدام فورم الادخال الزى تكرمت علينا به فعند تجربه الفورم لا يعمل مع الملف الكامل بصوره سريعه وكنت اظن ان اكود ثوف يكون اخف فى العمل من المعادلات ============== ارجوا ان اكون قد اوصلت طلبي اليكم ======== وارجو منك ان تحول لى المعادله الى كود وتخصص لى خليه احدد فيها رقم العمود المراد البحث فيه ========== بارك الله فيك وجعله فى ميزان حسناتك

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

استاذى الفاضل مهندس / محمد طاهر كل عام وانت بالف خير بارك الله فيك

حجا مقبولا ذنبا مغفورا تقبل الله اخى منا ومنك صالح الاعمال

مبدع اخى حماده عند نقل الفور الى ملف خاص بي لاحظت ثقل فى فتح الملف ما السبب فى رأيك