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

الشروحات كثيرة هنا في المنتدى والطرق كثيرة فقط ابحث بكلمة "فورم ادخال" وهذا شرح الكود الذي استخدمته وقد تعلمته من المنتدى Attribute VB_Name = "Module3" Private Sub CommandButton1_Click() ' سنقوم بشرح مبسط جدا للكود ان شاء الله 'نقوم هنا اولا بوضع المعطيات الثابتى التي ستكون مرجعا لنا في الكود 'بعد ذلك ' iRow السطر التالي لتحديد مرجع العمود وهو هنا Dim iRow As Long 'ws السطر التالي لتحديد مرجع الشيت المطلوب استخدامه وهو هنا Dim ws As Worksheet '================================================ 'ويمكن لنا تغيير المعطيات الثابتة لتكون كما نريد 'ws فمثلا يمكننا تغيير 'SH الي اي متغير مثلا '================================================ ' بطريقة بسيطة وسهله وبعيدا عن التعقيد والمصطلحات الكبيرة 'للتسهيل ليس الا ... واي استفسار الاكيد انني معكم دائما 'سأقوم بشرح الاكواد بابسط طريقة ممكنه 'السطر التالي معناه 'ان يجعل الشيت المطلوب استخدامه هو .... وهو هنا الشيت( ) 'ويجب وضع اسم الشيت المراد ترحيل وتسجيل البيانات ' "" الموجودة بالفورم بين علامتي التنصيص كما في السطر التالي Set ws = Worksheets("Sheet2") '================================================ ' بعد تحديد اساسيات العمل وتحديد الصفحة المطلوب الترحيل اليها ' يجب علينا اولا تحديد الصف الفارع الذي سيتم تسجيل البيانات الجديدة به 'حتي لا يتم الكتابة علي صف واحد كل مرة ولعمل ذلك نقوم بالتالي ... '================================================ ' نقوم بعمل سطر بسيط للعثور علي اول سطر فارغ في الصفحة ' المختارة لعمل عملية الترحيل وهي هنا شيت رقم 2 ' ولعمل ذلك نقوم بوضع السطر التالي ومعناه 'iRow اجعل 'ws في صفحة ' يساوي آخر صف في العمود رقم 1 ' وبذلك تم تحديد العمود الاول للعثور علي اول سطر فارغ فيه iRow = ws.Cells(Rows.Count, 1) _ .End(xlUp).Offset(1, 0).Row '================================================ 'سنقوم في السطور التاليه بوضع اكواد التسجيل او الترحيل 'وذلك بعد تحديد صفحة التسجيل وعمود البداية وتحديد او سطر فارغ فيه '================================================ 'ولترحيل البيانات نستخدم الاسطر التاليه 'وسنقوم بشرح السطر الاول والثاني فقط والباقي مثلهما تماماً '================================================ ws.Cells(iRow, 1).Value = Me.TextBox1.Value ' السطر السابق مقسم الي عدة اوامر وهي كالتالي ' ws اختيار صفحة الترحيل والتي تم اختيارها في بداية الكود 'Cells(iRow, 1).Value هذا الجزء معناه ان قيمة الخليه رقم 1 في الصف الفارغ ' الذي يتم تحديده عن طريق الكود وفي العمود المختار تساوي 'Me.TextBox1.Value هذا الجزء من السطر يعني ان قيمة الخليه رقم 1 كما سبق تساوي 'Me قيمة تكس بوكس رقم 1 في الفورم المستخدم وكلمة 'تعني هنا اليوزفورم المستخدم ws.Cells(iRow, 2).Value = Me.TextBox2.Value ' السطر السابق مقسم الي عدة اوامر وهي كالتالي ' ws اختيار صفحة الترحيل والتي تم اختيارها في بداية الكود 'Cells(iRow, 2).Value هذا الجزء معناه ان قيمة الخليه رقم 2 في الصف الفارغ ' الذي يتم تحديده عن طريق الكود وفي العمود المختار تساوي 'Me.TextBox2.Value هذا الجزء من السطر يعني ان قيمة الخليه رقم 2 كما سبق تساوي 'Me قيمة تكس بوكس رقم 2 في الفورم المستخدم وكلمة 'تعني هنا اليوزفورم المستخدم '================================================ 'وينطبق ذلك علي السطور التاليه مع تحديد الخليه المراد الترحيل لها ' قيمة التكست بوكس المطلوب في الفورم '================================================ ws.Cells(iRow, 3).Value = Me.TextBox3.Value ws.Cells(iRow, 4).Value = Me.TextBox4.Value ws.Cells(iRow, 5).Value = Me.TextBox5.Value ws.Cells(iRow, 6).Value = Me.TextBox6.Value ws.Cells(iRow, 7).Value = Me.TextBox7.Value ws.Cells(iRow, 8).Value = Me.TextBox8.Value '================================================ 'وبهذا تكون قد لنتهت عملية الترحيل حسب عدد التكستات الموجودة في الفورم ' والمطلوب تسجيلها او ترحيلها '================================================ ' ولتسجيل بيانات مرة اخري علي نفس الفورم وهو مفتوح نضع بعض الاسطر البسيطة 'لمسح البيانات القديمة من على الفورم بعد الترحيل للتجهيز لإدخال بيانات جديدة ' كما يلي '================================================ 'ولمسح البيانات القديمة نستخدم الاسطر التاليه 'وسنقوم بشرح السطر الاول فقط والباقي مثله تماماً '================================================ Me.TextBox1.Value = "" ' السطر السابق معناه ان يجعل قيمة التكست بوكس 1 تساوي لاشئ 'Me كلمه ' تعني الفورم نفسه المستخدم في التسجيل والترحيل كما سبق ذكره 'TextBox1.Value وهذا الجزء يعنس قيمة التكست بوكس 1 ' = "" وهذا الجزء يعني ان قيمة التكست بوكس 1 تساوي لاشئ ' حيث ان علامتي التنصيص تعني فراغ او لا شئ '================================================ 'وينطبق ذلك علي السطور التاليه مع تحديد التكست بوكس المراد مسح البيانات الموجوة به ' وما هنا في مثالنا كالتالي '================================================ Me.TextBox2.Value = "" Me.TextBox3.Value = "" Me.TextBox4.Value = "" Me.TextBox5.Value = "" Me.TextBox6.Value = "" Me.TextBox7.Value = "" Me.TextBox8.Value = "" '================================================ 'وبعد مسح البيانات نقوم بوضع جزء بسيط لتحديد التكست بوكس المراد بداية التسجيل منه ' وذلك بوضع مؤشر الكتابه في التكست بوكس المراد الادخال منه '================================================ 'ويتم ذلك عن طريق السطر التالي ' وفيه نحدد ان التكست بوكس 1 هو اساس بداية الادخال بعد مسح البيانات Me.TextBox1.SetFocus ' السطر التالي هو اقفال الكود ونهاية مهمة الزر المحدد 'والمستخدم لعملية التسجيل او الترحيل End Sub Private Sub CommandButton2_Click() End End Sub Private Sub UserForm_Click() End Sub

http://www.officena.net/team/khboor/kh_image/p22.gif المواضيع الحديثة دورة شرح الفيجول بيسك للتطبيقات VBA عبدالله المجرب [مفاجاة سارة] الدرس الرابع من سلسلة شروحات فيديو " الترحيل " أربعة أجزاء عبدالله المجرب امثلة عن كيفية استخدام أدوات الفورم (( متجدد ان شاء الله)) ضاحي الغريب اضخم كتاب لتعلم الصيغ والدوال في Excel 2007 امين بعض الدروس والتطبيقات على الاكسل فيديو (( متجدد )) قنديل الصياد سلسلة الفارس فى شرح دوال الإكسل ( فيديو ) متجدد رجب جاويش شرح دوال الاكسيل صوت وصورة ( باللغة العربية) ؛ أحمد النجار ؛ جميع النماذج من أكواد ومعادلات الخاصة بالتفقيط محمود_الشريف إنشاء القوائم المنسدلة (دروس للمبتدئين) ياسر خليل سلسلة الفارس فى شرح دوال الإكسل ( فيديو ) متجدد رجب جاويش شرح دوال الاكسيل صوت وصورة ( باللغة العربية) أحمد النجار جميع النماذج من أكواد ومعادلات الخاصة بالتفقيط محمود_الشريف

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

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

جزاك الله خير اخي ياسر خليل أبو البراء وبارك الله فيك واثابك الله الجنه ان شاء الله

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

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

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

وعليكم السلام أخي الكريم عامر حاول أن تضع شرح للمطلوب داخل الموضوع قبل الملف المرفق لتتضح الصورة لمن أراد تقديم المساعدة قبل الإطلاع على الملف ..بلاش كسل يا عامر يا عسل ضع الكود التالي في موديول عادي (اذهب لمحرر الأكواد Alt + F11 ثم من قائمة Insert أدرج موديول جديد من خلال الأمرModule) ثم ضع الكود التالي فيه Sub Teacher_Table() Dim Ws As Worksheet Dim Sh As Worksheet Dim strTeacher As String Dim iRow As Long Dim iCol As Long Dim Col As Long Dim Row As Long Set Ws = Sheet1 Set Sh = Sheet2 strTeacher = Sh.Range("E4").Value Application.ScreenUpdating = False Sh.Range("C7:G18").ClearContents For iRow = 8 To 37 For iCol = 4 To 30 Step 2 If Ws.Cells(iRow, iCol).Value = strTeacher Then On Error Resume Next Col = Application.Match(myDay(iRow), Sh.Range("C6:G6"), 0) Row = Application.Match(Ws.Cells(iRow, 2).Value, Sh.Range("A7:A18"), 0) If IsNumeric(Col) And IsNumeric(Row) Then Sh.Cells(Row + 6, Col + 2).Value = Ws.Cells(6, iCol - 1).Value Sh.Cells(Row + 7, Col + 2).Value = Ws.Cells(iRow, iCol).Offset(0, -1).Value End If End If Next iCol Next iRow Application.ScreenUpdating = True End Sub Function myDay(X As Long) As String Select Case X Case 8 To 13 myDay = "الاحد" Case 14 To 19 myDay = "الاثنين" Case 20 To 25 myDay = "الثلاثاء" Case 26 To 31 myDay = "الأربعاء" Case 32 To 37 myDay = "الخميس" End Select End Function ثم ضع الكود التالي في حدث ورقة العمل المسماة "جدول المعلمين" .. كليك يمين على اسم ورقة العمل ثم View Code ثم الصق الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$E$4" Then Call Teacher_Table End If End Sub وأخيراً اذهب لورقة العمل واختر اسم المعلم من الخلية E4 لتشاهد جدول المعلم .. لا تنسانا بدعوة بظهر الغيب تقبل تحياتي

أشكرك استاذ هو المطلوب

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

أخي الكريم هاني يرجى وضع الأكواد بين أقواس الكود ليظهر بشكل منضبط جرب الكود التالي عله يفي بالغرض .. قبل تنفيذ الكود حدد الخلايا المراد حمايتها ثم كليك يمين ثم Format Cells ثم انتقل للتبويب Protection ثم علم علامة صح بحوار الخيار Locked Sub Protect_All_Sheets() Dim Sh As Worksheet For Each Sh In Worksheets If Sh.ProtectScenarios = False Then Sh.Protect "aaaa" Sh.EnableSelection = xlUnlockedCells End If Next Sh End Sub تقبل تحياتي

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

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

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

بارك الله فيك أخي العزيز جلال وجزيت خير الجزاء

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

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

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

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

ياسر خليل أبو البراء اخى الفاضل جزاك الله خيرا

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

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

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

السلام عليكم بارك الله بك وبالاستاذ عبد الله المجرب دمتم

تم رفع هذا الكود فى مشاركة منفصله حتى لا ننسى هذه المشاركة كود لنقل البيانات تم ارفاق كود الحل من الفاضل / الحسامي _ عبد الفتاح كيرة _ عبدالله المجرب _ احمد فضيله و لا تنسونا من صالح الدعاء تحياتى المنقول الحسامى.rar المنقول-kemas (1).rar المنقول HaNcOcK 2 (1).rar

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

اكتب في نهاية الكود endif قبل end sub

'بعد إذن أخي أبو حنين ، قم بكتابة هذا في بداية الكود If Me.textbox1.Value = "" Then MsgBox "ضع الرسالة التي تريد ", vbOKOnly, "خطأ" textbox1.SetFocus ElseIf Me.TextBox2.Value = "" Then MsgBox "ضع الرسالة التي تريد ", vbOKOnly, "خطأ" TextBox2.SetFocus ElseIf Me.TextBox3.Value = "" Then MsgBox "ضع الرسالة التي تريد ", vbOKOnly, "خطأ" TextBox3.SetFocus Else

لي تعقيب بسيط للتنبيه والفائدة هنا هذا الشرط ليس لوجوده اهمية فهو يعمل مقارنة بين متغيرين تم اخذ قيمة لهما فوجوده زائد xLast = CLng(Right(DMax("ID", "tbl1", prtTxt = prtyr), 5)) اي يمكن ان يصبح السطر هكذا xLast = CLng(Right(DMax("ID", "tbl1"), 5)) كما ان استخدام الدالة clng لاحقا للتحويل تحتاج لوقفة ولكن بعد تفضل الاستاذ ابو خليل بشرح السبب ؟ فقد يبطل العجب ! وهنا استسمح صاحب الموضوع باختصار الكود بدون اي فكرة اضافية او عملية اختزال Private Sub Form_BeforeInsert(Cancel As Integer) prtyr = Right(DatePart("yyyy", Date), 2) xLast = Right(DMax("ID", "tbl1"), 5) If IsNull(xLast) Then xNext = 1 Else xNext = xLast + 1 End If Me!ID = "S" & prtyr & Format(xNext, "00000") End Sub تحياتي

معك نايف :) بارك الله فيك ونفع الله بعلمك وعملك , وأدخلنا وإياك جنته اللهم آمين

جرب ان تضيف قيمة واحدة على الاقل في حقل id ولتكن 1600001 ادخل قيم غير تاريخ الجهاز لسنة 2017 وهكذا طبعا بدون اضافة اللاحقة النصية تحياتي

يرجي عدم فتح اكثر من موضع لنفس المشاركة

الأخ زياد جرب المرفق الذي أنجر بطريقة أخرى حذف و لصق.rar

عزيزى السائل اليك كرت دوام قمت بتنفيذه من خلال ما تعلمته من هذا الصرح العمـــلاق اتمنى ان يلبى طلبك ... وللعلم منقول ... مع بعض التعديل عليه -- عليك كتابة الشهر بهذة الطريقة 1/2/2016 سيتغير معك التاريخ واليوم للشهر كامل -- باسورد الخلايا 1234 كرت دوام.rar

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

السلام عليكم تنسخ هذا الكود في زر الحفظ مع مراعات أن مربع النص الأول يملأ تلقائيا Private Sub CommandButton1_Click() Dim x As Byte, i As Byte, R As Integer, sh As Worksheet Set sh = Sheets("sheet2") With sh R = .Cells(Rows.Count, "B").End(xlUp).Row + 1 For x = 2 To 8 .Cells(R, x).Value = Me.Controls("TextBox" & x) '.Value Next End With TextBox1.Value = Sheets("sheet2").Cells(Rows.Count, "B").End(xlUp).Row - 1 For i = 2 To 8 Me.Controls("TextBox" & i) = "" Next End Sub و في حدث الفورم UserForm_Initialize تكتب هذا الكود الذي يقوم بمعرفة آخر صف مكتوب و ترقيمه Private Sub UserForm_Initialize() TextBox1.Value = Sheets("sheet2").Cells(Rows.Count, "B").End(xlUp).Row - 1 End Sub

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

السلام عليكم اخي الكريم هنا محاولة قد تفيدك asam.rar