نجوم المشاركات

السّلام عليكم و رحمة الله و بركاته تفضّل أخي الغالي " أبو عبد الرّحمن البغدادي " .. ربّما يكون المطلوب فائق إحتراماتي زيادة خانات الفورمة.rar

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

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

أخي الكريم أبو راكان جرب الكود التالي في حدث ورقة العمل كليك يمين على اسم ورقة العمل ثم اختر View Code ثم الصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("B1:I15")) Is Nothing Then Application.EnableEvents = False Application.ScreenUpdating = False If Target = 1 Then Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 50 Target = 1 ElseIf Target = 2 Then Range(Cells(Target.Row, "B"), Cells(Target.Row, "I")) = 100 Target = 2 End If Application.ScreenUpdating = True Application.EnableEvents = True End If End Sub عند حفظ المصنف يجب الحفظ بامتداد xlsm للحفاظ على الأكواد التي تم إدراجها لمزيد من التفاصيل يمكنك الإطلاع على موضوع "بداية الطريق لإنقاذ الغريق" لطائر البطريق ياسر خليل تقبل تحياتي

100% صحيح يعجز عن شكركم اخوينا مختار حسين واخونا ياسر خليل واتوجه الى الله بالدعاء لكما بأن الله يسعدكم ويفرج همكم ويرزقكم من واسع فضله

أخى الحبيب خيال تم تلبية طلبك دالة للجمع والتلوين على الرابط http://www.officena.net/ib/topic/65138-%D8%B9%D9%85%D9%84-%D8%AF%D8%A7%D9%84%D8%A9-%D8%AA%D9%82%D9%88%D9%85-%D8%A8%D8%A7%D9%84%D8%AC%D9%85%D8%B9-%D9%88%D8%AA%D9%84%D9%88%D9%8A%D9%86-%D8%A7%D9%84%D8%AE%D9%84%D9%8A%D8%A9-%D8%B9%D9%86%D8%AF-%D8%B1%D9%82%D9%85-%D9%85%D8%B9%D9%8A%D9%86/ أخى الحبيب مصطفى بارك الله فيك حللك جميل بس فيه ملاحظات استخدام نفس التنسيق الشرطى مرة على العمود E ومرة على العمود H فالأحرى تطبيق التنسيق على النطاقين مرة واحدة طالما لهما نفس التنسيق يعنى فى خانة appliese to نضع $H$6:$H$80;$E$6:$E$80= يوجد قيم خاطئة فى نتائج المعادلة بالعمودين E و H لأن فيه قيم نصية فى آخر العمودين لذلك تم اضافة الدالة IFERROR و اضافة تنسيق جديد والتعديلات فى المرفق المقارنة++++++.rar

السلام عليكم ورحمة الله بعد إذن إستاذنا واخونا الفاضل السيد علي العيدروس ملفك لايحتاج مفتاح فريد مثل رقم عميل او رقم سند لعدم التكرار لانة من الواضح سيتم التكرار تم إضافة بعض التعديلات ارتأيتها ضرورية 2- صفحة تحصيلات العملاء صفحة مدفوعات الموردين وهي تقريبا نفس صفحة تحصيلات العملاء صفحة مصاريف الشركة وهي تختلف بعض الش عن سابقاتها 1- تم إضافة عمود بمسمى الحساب لكي يرحل أي صف الي الحساب المطلوب ممكن تستفيد منة مستقبلا بأن اضفت حسابات أخرى اكثر وهنا إسم الحساب يرتكز علي إسم الصفحة (الشيت Sheet ) مهما بلغت ففي حالة وجود ذلك فقط قم بإضافتها أي ( الصفحة / الصفحات ) إلي القائمة المنسدلة وعند إختيارها فسيتم الترحيل الي هذه الصفحة مهما تعددت الصفحات ومهما تكررت سيأخذ الأول بالأول First In First Out . صفحة الخزينة وهي الأهم والتي يتم الترحيل إليها من عدة صفحات : تم بعض الإضافات عليها وتنسيقها إمكانية الاستفادة من تصفية البيانات وإعطاء بيانات او معلومات او حصر التحصيلات او مدفوعات الموردين او حصر المصاريف وتم عمل تنسيق شرطي في العمود D الجهة بحيث إذا كانت قيمة الخلية (تحصيلات العملاء) يتم تلوين كامل الصف باللون الأزرق فاتح وإذا كانت قيمت الخلية (مدفوعات موردين)يتم تلوينها باللون البنكي واما إذا كانت القيمة (مصاريف الشركة) فبالتلوين الأحمر للخلفية والخط بالاصفر. اما بخصوص الإجماليات مثل هذه : بعد عمل التعديلات فلا ادري في ماذا ستحتاج لها .بإمكانك عمل تصفية (فلترة) في ناحية الجهه ثم التاريخ سيعطيك نفس النتيجة إذا كنت ترغب في خلاف ذلك أي التعديلات الزائدة التي ممكن لا تتوافق مع متطلبات عملك او غير ذلك. وضًح وسيتم التعديل حسب الاستطاعة ملاحظـــــة / اخي احمد أبو ريان استميحك عذرا بأن اضع الموضوع في موضوع جديد لكي يستفاد منة كل من احتاجه بالبحث لان المشاركات لا تظهر بالبحث اخوك في الله / أبو الحسن والحسين لاحظت ان هناك صور لم تظهر فقمت بأخذ كامل الموضوع أعلاه مع الصور واسندتة بلمف وورد مرفق الملف ترحيل من عدة شيتات الى شيت واحد.rar

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

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

جميع بيانات الملفات لشهر واحد حسب ملفاتك الحاليه ؟ اضفت في بعض الملفات اشهر وهميه بمعنى بيانات لـ 6 اشهر جرب الكود التالي حط الملفات بنفس فولدر الملف الذي به الكود Sub Ali_Tran_Fil() Dim Pth As String Dim F_il As String Dim S_Nm As String Dim My_Vlu() As Variant Dim Lr, Lrr, R, Dy, Ar, Az, Ar_O, ii, rr, pp, Cr Dim Date_M As Date Dim O_Wp As Workbook Dim ws As Worksheet Dim Sh As Worksheet Dim Mi_A As Worksheet Dim sht As Worksheet Set Mi_A = Sheets(1) De_Sht CStr(Mi_A.Name) Apc_Ali False '-------------------------------------------------------------------- Pth = ThisWorkbook.Path & "\" '' مسار الملفات بنفس مسار الملف الحالي '-------------------------------------------------------------------- F_il = Dir(Pth & "*.xlsx") '' xlsx صيغة ملفات الاكسل التي سيتم جلب بياناتها '-------------------------------------------------------------------- ReDim Preserve My_Vlu(1 To 10000, 1 To 6) '-------------------------------------------------------------------- Do While F_il <> "" If F_il <> ThisWorkbook.Name Then S_Nm = Pth & F_il Set O_Wp = Workbooks.Open(S_Nm) Set ws = O_Wp.Sheets(1) Lr = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For R = 2 To Lr I = I + 1 My_Vlu(I, 1) = ws.Cells(R, 3) My_Vlu(I, 2) = ws.Cells(R, 1) My_Vlu(I, 3) = ws.Cells(R, 2) My_Vlu(I, 4) = ws.Cells(R, 6) My_Vlu(I, 5) = ws.Cells(R, 7) My_Vlu(I, 6) = Split(F_il, ".")(0) Next R O_Wp.Close False F_il = Dir End If Loop '-------------------------------------------------------------------- Mi_A.Range("A2").Resize(UBound(My_Vlu, 1), UBound(My_Vlu, 2)) = My_Vlu '-------------------------------------------------------------------- Mi_A.Sort.SortFields.Add Key:=Mi_A.Range("D2", Mi_A.Range("D2").End(xlDown)), _ SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Mi_A.Sort .SetRange Mi_A.Range("A2:F" & Mi_A.Range("A1").End(xlDown).Row) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With '-------------------------------------------------------------------- With CreateObject("scripting.dictionary") For ii = LBound(My_Vlu, 1) To UBound(My_Vlu, 1) If My_Vlu(ii, 1) <> "" Then If IsDate(My_Vlu(ii, 4)) Then Date_M = My_Vlu(ii, 4) Dy = .Item(Month(Date_M)) End If End If Next ii Ar = Split(Join(.Keys, ","), ",") End With '-------------------------------------------------------------------- For rr = LBound(Ar) To UBound(Ar) If IsError(Evaluate("'" & Ar(rr) & "'!A1")) Then Set Sh = ThisWorkbook.Worksheets.Add(After:=Worksheets(Worksheets.Count)) With Sh .Name = CStr(Ar(rr)) Az = Array("رقم العميل", "العدد", "الصنف", "التاريخ", "السعر", "إسم الملف") With .Range("A1") .Offset(0, 0).Resize(1, UBound(Az) + 1) = Az End With .Columns(1).ColumnWidth = 29.29 .Columns(2).ColumnWidth = 8.43 .Columns(3).ColumnWidth = 15 .Columns(4).ColumnWidth = 16.14 .Columns(5).ColumnWidth = 8.43 .Columns(6).ColumnWidth = 8.43 End With End If Next rr '-------------------------------------------------------------------- Ar_O = Mi_A.Range("A1").CurrentRegion.Value For Each sht In Sheets If Not sht.Index = 1 Then For pp = 1 To UBound(Ar_O, 1) If IsDate(Ar_O(pp, 4)) Then If Trim(Month(Ar_O(pp, 4))) = Trim(sht.Name) Then With sht Lrr = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row .Cells(Lrr, 1) = Ar_O(pp, 1) .Cells(Lrr, 2) = Ar_O(pp, 2) .Cells(Lrr, 3) = Ar_O(pp, 3) .Cells(Lrr, 4) = Ar_O(pp, 4) .Cells(Lrr, 5) = Ar_O(pp, 5) .Cells(Lrr, 6) = Ar_O(pp, 6) End With End If End If Next pp End If Next sht '**** Sh_S '**** '\\\\\\\\ Cr = Split(Mi_A.UsedRange.Address, "$")(4) Mi_A.Range("A2:F" & IIf(Cr = 1, 2, Cr)).ClearContents '//////// Apc_Ali True '************************************ Set O_Wp = Nothing: Set ws = Nothing Set Sh = Nothing: Set Mi_A = Nothing Set sht = Nothing: Erase My_Vlu End Sub Private Sub B_Set(Sh_N()) Dim T_m Dim I, J '---------------------------------- Apc_Ali False For I = LBound(Sh_N) To UBound(Sh_N) For J = I To UBound(Sh_N) If Sh_N(I) > Sh_N(J) Then T_m = Sh_N(I) Sh_N(I) = Sh_N(J) Sh_N(J) = T_m End If Next J Next I Apc_Ali True '---------------------------------- End Sub Private Sub Sh_S() Dim Sht_a As Worksheet Dim My_Sh() Dim I '------------------------------------------ Apc_Ali False ReDim My_Sh(ThisWorkbook.Worksheets.Count) I = LBound(My_Sh) For Each Sht_a In ThisWorkbook.Worksheets My_Sh(I) = Sht_a.Name I = I + 1 Next Sht_a '----------- B_Set My_Sh '----------- For I = LBound(My_Sh) + 1 To UBound(My_Sh) If Sheets(My_Sh(I)).Index <> 1 Then Worksheets(My_Sh(I)).Move After:=Worksheets(ThisWorkbook.Worksheets.Count) End If Next I Apc_Ali True '------------------------------------------ End Sub Public Function De_Sht(ByVal Nm_S As String) Dim Sh_D As Worksheet ''------------------------------------ For Each Sh_D In Worksheets Application.DisplayAlerts = False If Sh_D.Name <> Nm_S Then Sh_D.Delete Application.DisplayAlerts = True Next Sh_D ''------------------------------------ Set Sh_D = Nothing End Function Public Function Apc_Ali(Bll As Boolean) ''------------------------------------ With Application .Calculation = IIf(Bll, -4105, -4135) .ScreenUpdating = Bll .EnableEvents = Not Bll End With ''------------------------------------ End Function والمرفقات الملف وبه الكود new_Ali.rar

واقول المنتدى منور ؟ وشامين ريحة عود وعنبر ! تحياتي الاستاذ القدير ابو احمد

السلام عليكم المرفق الاول الشرح والاخر الملف شرح_5.rar البحث بين تاريخين_A.rar

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

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

السلام عليكم ورحمة الله وبركاته تحية عطره الى جميع اعضاء اوفيسنا هذا هو اول نشر لهذا الموضوع فى اوفيسنا اتمنى ان ينال اعجابكم الرابط http://excelfinancial1.blogspot.com.eg/p/blog-page_53.html

بالامكان ذلك في حدث Thisworkbook مباشره عند دخولك الصفحه Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.UsedRange.Columns.EntireColumn.AutoFit End Sub

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

سلمت يمينك أستاذنا الكريم

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

السلام عليكم - حياكم الله - مبارك عضوية الاحتراف - بارك الله فيكم وزادتكم فضلا وعلماً اشكرك وجزيت خيرا على الحل - تمام

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

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

السلام عليكم شكرا استاذ مختار عمل رائع وتعديل اروع جزاكم الله خيرا

السلام عليكم ورحمة اله ملف Word كيفية تلوين صف بناء علي قيمة خلية مع ملف إكسل كمثال مصغر اخوكم في الله / أبو الحسن والحسين شرح تلوين الصف بناء علي خلية مع مثال2.rar مع الانتباة : لكي تعطى النتيجة السليمة قم بمراجعة تحرير وصف القاعدة أي الصيغة ادناه ( "مشغول"=5 M$ =) تلقاها بالخطأ ( "مشغول"=1048576 M$ =) قم بتعديلها حسب الموضح بالشكل.

السلام عليكم ورحمة الله.rar ملف وورد فقط

كل الشكر والتقدير للاخ الغالي KHMB لمساهمته تفضل اخي احمد المطلوب مساجد .rar

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

اذهب الى الدالة التاليه في الكود Private Function Ch_Month(Mn As String) Dim Mm& Dim Tn$, X$ For Mm = 1 To 12 Tn = MonthName(Mm) If Tn = Trim(Mn) Then Mm = Mm - 1 X = MonthName(Mm) Exit For End If Next If Mm Then Ch_Month = X End Function واستبدلها بهذا التعديل Private Function Ch_Month(Mn As String) Dim Im, Tn, X Dim Ar On Error GoTo 1 Ar = Array("يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") For Im = 0 To UBound(Ar) Tn = Ar(Im) If Tn = Trim(Mn) Then Im = Im - 1: X = Ar(Im): Exit For Next Im Ch_Month = X 1 End Function اضن السبب تسمية الاشهر لديك ربما تكون بالفرنسية في الـ VBA

السلام عليكم ورحمة الله اخى الحبيب اليك الحل المكافآت.rar

أخى أبو يوسف أنا مجرب الملف قبلك عدة مرات و لا تظهر لى هذه الرسالة تخلص من جميع المرفقات المقدمة منى أو من أستاذنا ياسر و تأكد من عدم وجود ملفات اكسل بنفس الاسم وجرب المرفق الأخير فى مشاركتى الأخيرة Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

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

أخى وأستاذى الغالى بارك الله فيك . اكتشفت خطأ فى المعادلة SUMPRODUCT و تم التصحيح أخى أبو يوسف المرفق التالى لحساب عدد التكرار لكل مكتب في جميع الاوراق هذا المرفق به كودين يتم استدعائهما بزر واحد اذا كنت تريد استدعاء كل كود على حده كما طلبت فى مشاركتك الأخيرة يمكنك التعديل بسهولة كالتالى السطر التالى فى الكود الاول يحذف Call CopyToNewSheet أضف شكلا تلقائيا أو زر و اربطه بالكود الثانى وأى ملاحظات أخرى فأهلا و سهلا بها فلا تخجل تحياتى لك ولأخى وأستاذى أبا البراء Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

استبدل الكود عندك بها الكود وسوف ترى النتيجة Sub زر_1() lh = Cells(Rows.Count, "H").End(3).Row lc = Cells(Rows.Count, "c").End(3).Row Range("H5:H" & lh).Clear Range("c5:c" & lc).SpecialCells(xlCellTypeConstants, 1).Copy Range("H5") End Sub

Database date+ -.rar

مثال رقم 3 :- فى المثال رقم 2 كان الشرح على نفس الصوره السابقه فورم فى مرحلة التصميم وصممت عليه Frame والفريم لا يوجد به اى عناصر تحكم تم تصميمها وكان المثال برقم 2 انى اعمل كود عند فتح الفورم يكون هناك عدد 10 صفوف من العناصر كل صف به ليبل وتكست بوكس وكمبوبوكس المثال بتاعنا اليومعايز اعرف ازاى اضيف عناصر تحكم اثناء فتح الفورم من شيت اكسيل وعدد الصفوف بالشيت غير معروف عددها فى زياده او نقصان شاهد الصوره هتعرف اكتر المثال بتاعنا بكل بساطه نفس الكود اللى بالمثال 2 مع تعديلات فنيه بسيطه جدا دا كان الكود اللى بالمثال 2 Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer Top = 5 For i = 1 To 10 With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = "الصقر" & i End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub ايه المطلوب تعديله بالكود لكى يتناسب مع المطلوب بتاعنا رفع الخلايا من الشيت الى الفريم المثال كان على ان عدد الصفوف 10 لذالك استخدمنا الحلقه For next كالتالى For i = 1 To 10 فدلوقتى انا عايز اجيب الخلايا بالشيت رقم 1 النطاق من A2 الى اخر صف هيكون به اخر طالب اذن بداية الحلقه هى اول صف بالجدول وهو الخليه A2 ورقم الصف لها هو 2 اذن الحلقه هتبدأ من رقم 2 الى ؟ الى اخر صف به بيانات فى العمود A اذن لازم احدد اخر صف به بيانات من خلال السطر التالى واحنا شرحناه قبل كدا lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row عملت متغير واسمه Lr وتقدر تسميه اى اسم كيفما شئت وقلت ان المتغير Lr يساوى كتبت اسم الشيت المراد العمل عليه واستخدمت Cells لتحديد عدد الخلايا الممتلئه بالبيانات فى العمود 1 كدا انا عرفت الحلقه من اين تبدأ واين تنتهى ( تبدأ من الصف 2 الى اخر صف به بيانات ) For i = 2 To lr شاهد الكود بعد تعديل الحلقه For Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Top = 5 For i = 2 To lr With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a .Text = Sheet1.Cells(i, 3).Text End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = Sheet1.Cells(i, 1).Text End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub اللى مركز معايا هيلاقى 1- تم تعديل بداية ونهاية الحلقه For 2- فى سطر تم اضافته فى خصائص كل عنصر فى عنصر الكمبوبوكس تم اضافه السطر التالى .Text = Sheet1.Cells(i, 3).Text قيمة الكمبوبوكس هى كتبت اسم الشيت وهو بمثالنا الشيت 1 ثم الخلية المطلوبه Cells عباره عن (رقم العمود, رقم الصف)Cells ( Cells( i , 3 i هنا هى رقم الصف اللى هيتغير كل مره بالحلقه For والعمود هو رقم 3 الخاص بالحاله --------------------------------- فى عنصر التكست بوكستم اضافه السطر التالى .Text = Sheet1.Cells(i, 2).Text نفس الكمبوبوكس ولكن تم تغيير رقم العمود هو 2 الخاص بالدرجه ---------------------------------- فى عنصر الليبل تم اضافه السطر التالى .Caption = Sheet1.Cells(i, 1).Text نفس الكمبوبوكس والتكست بوكس ولكن تم تغيير رقم العمود هو 1 الخاص باسم الطالب ----------------------------------------------------------------------------------------------------------------------- ملحوظه اخيره لمن يريد درجة الاحترافيه فى الكود لما كنا بنعمل خصائص العنصر كان الخاصيه Left & Top & Width& Height لكل عنصر كان بيتم كتابتهم بالشكل التالى كلا منهم على حد فى سطر مختلف على سبيل المثال خصائص التكست بوكس With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With ممكن اكتب الاربع خصائص فى سطر واحد من خلال Move القاعدة الخاصه بــ Move Move Left, Top, Width, Height. ويكون شكل الكود كالتالى بالخصائص With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Move 180, Top, 150, 40 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With تم استبدال الاربع صفوف بسطر واحد من خلال Move -------------------------------------------------------------------------------------------------------- جرب الكود بنفسك هتثبت المعلومه اكتر الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد ان شاء الله هيكون عن كيفية التحكم فى العناصر الموجوده داخل الفريم سوء كانت مصممه اثناء عملية التصميم او تم انشائها بكود انتظرونا تقبلوا تحياتى

أخي الغالي ياسر فتحي بارك الله فيك على الموضوع الجميل أخي الكريم عبد العزيز نظراً لأنك تستخدم اللغة الفرنسية فيمكنك استخدام الدالة CAR المقابلة للدالة CHAR تقبلوا تحياتي

أخى و أستاذى أبا البراء بارك الله فيكم وجعل فى ميزان حسناتك

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

ادعو الله خير و ترجع بخير و سلامة

لعله خيرا باذن الله وترجع بالسلامة

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

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

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

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

السلام عليكم ورحمة الله أخي الكريم عباس، لم أفهم في البداية ما تريده بالضبط وأعتقد أن أخي الكريم الشهابي قد وفى المطلوب جازاه الله خير الجزاء وبارك الله فيه... وأقدم حلا آخر دائما بالتنسيق الشرطي على كل خلايا النطاق D4:AA37 بعد تعديل في معادلات أعمدة المدرسين (الأرقام كانت بتنسيق نص) فأضفت *1 أمام الدالة INDEX في المعادلات التي تجلب رقم المدرس... أرجو أن يفي هذا أيضا بالغرض... أخوك بن علية المرفق : تنسيق شرطي للمكرر جدول الحصص .rar

أحي العزيز / عباس السماوي هذه محاولة مني للحل لعلها المطلوب إن شاء الله مع تقديرنا لأستاذنا الكبير ومعلمنا الجليل / بن علية حاجي حفظه الله تقبل تحيات وتقديري لكم تنسيق شرطي للمكرر جدول الحصص _2.rar

بسم الله الرحمن الرحيم اليوم نقدم لكم برنامج جديد أرجوا أن تجدوا فيه الفائدة وأن يحقق لأحدكم النفع في حياته العمليه ملحوظه ( جميع البرامج السابقة سنجمعها لكم قريباً وبصورة أرجوا أن تنال رضاكم ) برنامج اليوم : هل لديك عقار صغير تقوم بتأجيره ؟ إذا كان الجواب نعم . فأليك برنامج اليوم الذي سيساعدك في تسجيل كل عملية تأجير ومتابعة تسديد الدفعات والأيجارات والمصروفات والحصول على تقارير كاملة عند تشغيل البرنامج ستظهر لكم الشاشة التالية وعند الرغبة في تسجيل تأجير جديد عليك أولاً الذهاب لصفحة الأسماء وتسجيل أسم المستأجر وسوف يقوم البرنامج تلقائياً بأعطاؤه رقم متسلسل فلا تقوم بالترقيم بنفسك .. الرقم هام جدا فسوف نحتاجه في كل خطواتنا بالبرنامج الآن وبعد أن قمنا بتسجيل أسم المستأجر الجديد وعرفنا رقمه . نقوم بالتوجه لصفحة تسجيل بيان أيجار جديد ونكتب فقط رقم المستأجر ليظهر لنا أسمه .. وهنا نقوم بأدخال مبلغ الأيجار المطلوب بالكامل منه وكذلك نكتب بيان يصف عملية الأيجار للتذكير . التاريخ سيظهر تلقائياً وفق تاريخ اليوم ويمكنك تعديله أن أردت ذلك الآن في حال الرغبه في تسديد دفعات من هذا المستأجر عليك التوجه الي صفحة التسديد وسنقوم أيضاً بكتابة رقم المستأجر وسيظهر لنا أسمه والمبلغ المطلوب منه وبياناته السابقه . نقوم بكتابة المبلغ أو الدفعه التي سيسددها وستظهر رساله بالباقي عليه وسيظهر تاريخ اليوم ويمكن تعديله ويمكننا تسجيل وصف لعمليةالتسديد للتذكير يمكنك الحصول على تقرير بحالة المستأجرين وستجد زر بالصفحة الرئيسية يذهب بك لتلك الصفحه . ولكن عند طباعة التقرير يجب الضغط على زر الطباعه الموجود بالصفحه لكي يطبع لك البيانات فقط دون الحاجه لطباعة الصفحات الفارغة يمكنك الحصول على تقرير عام بالأجماليات عبر الزر المخصص لذلك بالصفحة الرئيسية يمكنك الحصول على تقرير بحالة مستأجر واحد وذلك بالضغط على الزر المخصص لذلك وعند الذهاب للصفحه فقط عليك كتابة رقم المستأجر البرنامج في المرفقات مضغوط ببرنامج الـ Winrar لا تنسونا من خالص الدعاء منتظر إقتراحاتكم للتطوير أو التعديل .. وبالتوفيق للجميع _______________.rar