أسامة البراوى

مرفق واضح انك مدرس لغة عربية .... حريص على المذكر والمؤنث ابقى افتح موضوع جديد لو عايز حاجة تانى ترحيل مفيد باختبار اعمدة معينة 2.rar

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

المعادلة تبحث عن جزء من الجملة "دور ثان" واذا وجدته ضمن محتوى الخلية بترد برقم يعبر عن مكانه وفى الحالة دى الدالة if تعتبرها true ويتحقق الشرط طالما كان فيه هذا الجزء مهما كان طول محتوى الخلية اما اذا لم يجد هذا الجزء فالرد برسالة خطأ تعتبر FALSE وبالنسبة للاستدعاء يجب تعديل الكود ترحيل مفيد باختبار اعمدة معينة 2.rar

السلام عليكم الاخ ابو سليمان من واقع كلامك فإن الملفات فى المجلد الاول تحدث بصفة يومية اى يتم ادخال البيانات اليها بصفة يومية مثلا تكون البيانات فيه حتى يوم 26/5/201005 اما المجلد 2 فاخر بيانات فيه هى حتى يوم 25/5/2015 هل تريد 1- مقارنة المحتوى الجديد بالمجلد الاول واضافة بيانات اليوم الجديد الي ملفات المجلد الثانى دون التأثير على المعادلات ( اضاقة اليوم 91، 92 ، 2- ام مسح البيانات الموجودة بالكامل فى الملفات الموجودة بالمجلد 2 واستبدالها بما هو جديد بدون التأثير على اى معادلات قد تكون موجودة

المرفق ترحيل مفيد باختبار اعمدة معينة.rar

السلام عليكم انا اظن انه عايز يغير فى العمود الخاص بالنتيجة وفى الحالة دى ممكن نعدل الشرط للبحث عن جزء من الكلمة "دور ثان" وسينفذ الكود مهما اضاف قبلها او بعدها (له او لها) نضع الكود ElseIf InStr(1, Cells(R, 113).Value, "دور ثان") Then مكان الكود ElseIf Cells(R, 113) = "دور ثان في" Then

اتفضل تم اضافة الكود لكى يقوم بالتالى بعد نقل النتائج 1- مسح نتيجة الامتحان 2- تلوين خانات المواد بالون الاصفر 3- اضافة معادلة النتيجة الجديدة (تجمع اعمال السنة مع نتيجة امتحان الدور الثانى - اظن انك قد ترغب فى وضع حد اقصى ليها .... ابقى بلغنى اعمل لك التعديل) ترحيل الدور الثاني-OB4.rar

يجب ضغط ملفات الاكسل والورد لرفعها

2- ازاى عمل التيكست بوكس disabled وهو بيبنى الفورم عمل فحص على الخلايا واللى لقى فيها معادله زود لها الخصائص دى If MyRngdate.Cells(2, Ar(t)).HasFormula = True Then .BackStyle = 0 .TextAlign = 2 .SpecialEffect = 3 .Enabled = False End If شوف عايز ايه تانى ورد علي سوالى فى اولا لان اللى عمل الفورم دى دماغ عالية قوى

السلام عليكم اولا منين جبت الفورم الجميل ده ثانيا نبدأ فك الالغاز اللى انت عايزها 1- بالنسبة لموضوع الكمبو بوكس : -يقوم المبرمج من خلال دالة Kh_TesTtype بفحص رؤس الاعمدة بحثا عن comments اللى هى فى الاساس اسم نطاق البيانات المتاحه لهذا العمود (قارن بين الاسماء المعرفة من قائمة Names والملاحظات - وبعدها يختار انه يضيف كمبو بوكس بدل التكست بوكس ويحدد نطاق الاختيار Public Function kh_TestType(rng As Range, Optional iT As Boolean = False) As Boolean If Not rng.Comment Is Nothing Then MyList = Trim(Replace(rng.Comment.Text, Chr(10), "")) MyList = Replace(MyList, " ", "") If TypeName(Evaluate(MyList)) = "Range" Then kh_TestType = True End If End If End Function

السلام عليكم اولا: ياريت تعمل الجدول اللى فى الملف َq2 صح وبالعنواين للاعمدة ثانيا: ايه الفرق او العلاقة بين المستحق للمنحة وصاحب المعاش او ايه العلاقة بينهم حاول تعدل الملفات وتبعتها تانى ..... وربنا يكرم ان شاء الله

السلام عليكم اظن هذا يعمل بدون مشاكل ترحيل الدور الثاني-OB3.zip

شكرا لمرورك تم التعديل بصيغة EXCEL 2003

السلام عليكم مؤقتا الى ان تظبط طلبات استاذ ياسر مرفق الدالة المطلوبة عسى ان تفيدك برنامج الدراسة2015-2016 جديد.rar

السلام عليكم بعد التحية الى جميع اعضاء المنتدى الكرام اظن البعض قد يقول ان الموضوع متكرر لانى شفت الدالة موجودة مسبقا فى احد الردود واناجربتها لكن وجدت فيها بعض الملاحظات الصغيرة، منها 1- ان فيها خطأ لو الواحد نسى يدخل العملة الرئيسية او الفكة 2- انك لما تحدد الفكة مثلا بيظهر 25/100 قرش !! 3- ولو كانت الفكة مثلا 0.251 هاتظهر 251 قرش ولانى كنت عامل دالة تعمل نفس الوظيفة مسبقا قمت بتعديل واضافة النسخة الانجليزية منها ومن المميزات فيهما: 1- ادخال العملة اختيارى 2- مراعاة بعض القواعد النحوية حسب علمى 3- الدالة شغالة حتى 999 مليون 4- كتابة الكسور مع مراعاة الفكة لما تكون واحد من الف زي الريال العمانى = 1000 بيسة مثلا وكذلك تجاهل اى كسور زائدة عن الحاجة وهما مرفقتان هنا وارجو من الجميع الاستفادة والتجريب واخطارى لو فيه خطأ حصل تبلغونى WriteDownNumbers.zip

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

السلام عليكم بعد إذن الاستاذ الكبير ياسر (علشان انا كنت باجهز الرد) ممكن برضه تجرب الكود ده Sub UpdateData() Dim R Dim WbkName As String Dim MyPath As String MyPath = ActiveWorkbook.Path If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" Dim xl0 As New Excel.Application For R = 2 To 6 WbkName = MyPath & Cells(R, 1) & ".xlsx" Dim xlw As New Excel.Workbook Set xlw = xl0.Workbooks.Open(WbkName) xl0.Worksheets("المعلومات الأساسية").Cells(6, 1) ="تاريخ الاستقالة" xl0.Worksheets("المعلومات الأساسية").Cells(6, 2).Value = ActiveSheet.Cells(R, 2).Value xlw.Save xlw.Close Set xl0 = Nothing Next Set xlw = Nothing End Sub

جرب ده 02_ملف_الخزينة_بالمعادلات.rar

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

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

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

ماشاء الله ... جميلة ... وفعلا غير معروف لدى الكثيرين مع اهميته شكرا

تمام يا استاذ ياسر انا فعلا ما انتبهتش الى العمود المخفى وفى الحالة دى مكن يتعدل الكود الى التالى باستعمال عمود ظاهر Sub Final() Sheet7.Range("a6:ak100") = "" Application.ScreenUpdating = False x = Sheet6.[G1000].End(xlUp).Row For t = 11 To x Step 3 y = Sheet7.[A1000].End(xlUp).Row + 1 If Sheet6.Range("au" & t).Value = "له دور ثان فى" Then Sheet7.Range("a" & y) = Sheet6.Range("E" & t).Value Sheet7.Range("b" & y) = Sheet6.Range("G" & t).Value Sheet7.Range("e" & y & ":ak" & y) = Sheet6.Range("j" & t + 2 & ":ap" & t + 2).Value Else End If Next Call errase Application.ScreenUpdating = True End Sub

فكرة جميلة يا استاذ ياسر

السلام عليكم ارى ان هذا حل جميل ويفى بالغرض وممكن ان نضيف الاسطر التالية فى نهاية الكود لكى نحافظ على الشكل العام للشيتات الجديدة Dim I As Intger For Each SH In Worksheets If SH.Name <> "ورقة1" Then For I = 1 To 6 SH.Columns(I).ColumnWidth = Sheets("ورقة1").Columns(I).ColumnWidth Next End If Next SH