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

السلام عليكم هذا البرنامج حملته من اليوتيوب صاحبة عرضة مجانا يمكن تستفيدوا من البرمجة وخاصة الاخوة المبتدئين للامانة العلمية -- صاحب البرنامج اسمه صادق الزبيدي sadeq.rar

تفضل 🙂 . . جعفر 1068.Database1 (1).accdb.zip

وأخيرا بفضله وكرمه علينا تم الانتهاء من عمل الفيديو الذى ينتظره الكثيرون مع محمد جابر تعلم فى الاكسيل ترحيل الطلبة الناجحون والراسبون · سوف نتعلم باذن الله تعالى في الدرس بعض الدوال وخصائصها وكيف العمل بها · كما ستتعلم كيفيه ان تعلم نفسك بنفسك في صناعة دوال الترحيل فيديو مفيد باذن الله مشاهدة ممتعة 🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏 ♦ رابط الشرح على اليوتيوب: https://youtu.be/CG98wMuDapg ♦ والفيديو الاصلى تجدوه فى (تليجرام) على الرابط التالي : https://t.me/technologyeduM ♦ الملف المستخدم في الشرح ستجدوه اسفل الفيديو في اليوتيوب 🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏🍏

فقط تحتاج الى إضافة حقل في الجدول ترقيم تلقائي وفرز حسب هذا الحقل test550055vv.mdb

وعليكم السلام ورحمة الله وبركاته تفضل ضع هذا الكود في وحدة نمطية Public Function UpdateCounter() Dim SQL As String Dim Rs As New ADODB.Recordset Dim counter As Long counter = 1 SQL = "SELECT IDx" & _ " FROM table1 ORDER BY table1.Idx" With Rs .Open SQL, CurrentProject.Connection, adOpenKeyset, adLockOptimistic Do While Not .EOF ![idx] = counter counter = counter + 1 .Update .MoveNext Loop .Close End With Set Rs = Nothing End Function وقم باستدعائه تحت زر الامر هكذا UpdateCounter Me.Requery test550055.mdb

أخى الفاضل هانى الحلاج انظر بالمرفق عسى أن يكون المطلوب 1.zip

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

الأخ الكريم ازهر عبد العزيز فى المرفق مجرد تصور لا ادرى إن كان يفى بالغرض .. أعتذر عن التأخير. بالتوفيق 54.zip

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

في الواقع المسألة يحتاج لها حك راس شوي 🙂 انا توصلت للتالي: 1. نعمل جدول بأسماء المدرسين ، وبدون تكرار ، وانا اتوقع يكون عندك هذا الجدول: . 2. استعلام به كل البيانات . وعملت الحقل T علشان يجمع عدد المرات اللي تكرر فيها الاسم في بقية الحقول: . والنتيجة . 3. استعلام آخر للمجاميع . والنتيجة . جعفر 1070.Course Alternative App2.accdb.zip

وعليكم السلام تفضل لك ما طلبت-كما يمكنك زيادة اعداد الموظفين كما تشاء فى جدول البيانات المعطاة المصنف6.xlsx

انظر المرفق في ردي السابق

الف شكر أستاذ عبد اللطيف جزاك الله خيرا

تسلم انا اشتغل معي ربي يحفظك استاذ

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

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

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

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

اعانى من مشاكل فى الاتصال بالانترنت لذلك اعذرنى سوف اجيبك نظريا 1- قم بعمل موديول جديد 2- ضع هذ الكود داخل الموديول Rem اول يوم فى الشهر Public Function FirstDateOfMonth(MyDate) FirstDateOfMonth = CDate("1/" & DatePart("m", MyDate) & "/" & DatePart("yyyy", MyDate)) End Function Rem اخر يوم فى الشهر Public Function LastDateOfMonth(FirstDateOfMonth) LastDateOfMonth = DateAdd("d", -1, DateAdd("m", 1, FirstDateOfMonth)) End Function فى النموذج الان لنفترض انك وعلى حسب سؤالك يوجد 2 مربع نص لنقترض ان الاول اسمــــه txtStart ولنفترض ان الثانى اسمه txtEnd على حسب سؤالك او على حسب فهمى انت تريد عند وضع اى تاريخ بالمربع الاول txtStart مهما كان يتم ارجاعه الى اول يوم لهذا الشهر والمربع الثانى txtEnd اخر يوم لنفس الشهر الذى قام بإدخاله المستخدم فى مربع النص الأول txtStart قم بعمل كود عند التحديث للمربع الاول بهذا الكود Private Sub txtStart_AfterUpdate() [txtStart] = FirstDateOfMonth([txtStart]) txtEnd = LastDateOfMonth([txtStart]) End Sub وان شاء الله تجد كل شئ تمام طبعا ممكن عمل الكود على النموذج مباشرة ولكن احبذه هكذا لسهولة استدعاءه فى اى وقت ومن اى مكان ولاى تاريخ واخبرنى النتيجة التى توصلت اليها لو تكرمت بعد التطبيق

جزيتم خيرا جميعا حصل المطلوب بارك الله فيكم

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

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

مشكور جداً اخي علي على هذا الكود لكن الموضوع ليس تحديداً تقسيم الاسم (يوجد اشياء كثيرة بهذا الشأن) بقدر ما هو قدرة تطويع REGULAR EXPRESSION التي تستعمل كما هو معروف مصطلحات مثل (w+.\d \ s الخ..... ) لتعمل مع اللغة العربية

المشكلة عندك في الجداول انت وضعت في الجدولين حقلي pcode ترقيم تلقائي ومفتاحين ايضا وفي النموذج الفرعي في الاستعلام مصدر البيانات داخل النموذج عملت علاقة بين الحقلين ، وهذا خطأ انا الآن حولت احد الحقلين ( الجدول الفرعي) لرقمي فقط قابل للتكرار وهذا هو الصحيح .. تكون العلاقة رأس لأطراف Lab 2019.rar

وعليكم السلام ورحمة الله وبركاته انا قمت بتبديل المسميات العربية بحروف انجليزية لتسهيل العمل اختصرت لك الأوامر التي قمت بعملها انت جرب ووافني بالنتيجة هذا هو الاستعلام المعمول به بدل الثلاثة استعلامات الخاصة بك وأعطى نفس النتيجة التي تريد SELECT DFTbl.ID, DFTbl.Dt, DFTbl.Dw, DFTbl.Fw, DSum("[fw]","Qry","ID<=" & [ID])-DSum("[dw]","Qry","ID<=" & [ID]) AS FwateerPalance, DateDiff("d",[Dt],Now()) AS DtNum, moneyAge([DtNum]) AS [note] FROM DFTbl ORDER BY DFTbl.ID, DFTbl.Dt; يبقى امر سرعة الانجاز :: تحياتي اعمار_الديون_-_اسلام_الشيمى.accdb

تفضل Private Sub id_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyF6 Then SendKeys "^'", True End If End Sub db2.mdb

وعليكم السلام 🙂 يمكن عمله بصيغة رقم: وصيغة نص 🙂 جعفر

لا حاجة لادراج الاساسي والاضافات اكسل يحسبها وحده الملف مرفق Rawateb.xlsm

أحسنت أستاذ سليم كود بمعادلة معرفة ممتاز جعله الله في ميزان حسناتك لا يوجد حل افضل مما قدمه لك الأستاذ الكبير سليم فموضوعك وطلبك لا يمكن عمله مباشرة الا بداله الأستاذ سليم فاذا كنت تريد معادلات عادية فلابد من عمل وتأسيس أعمدة مساعدة , ويتم العمل بمعادلة VLOOKUP فعليك بكتابة كل الأرقام بهذه الطريقة لجعلها مصدر للمعادلة فلابد من تكملة الأرقام بهذه الطريقة الى ما تريده Order_Me2.xlsm

بسم الله الرحمن الرحيم اخواني في الله هذا ملف جامع لموضوع استدعاء البيانات من اعمده مختلفه بمعايير مختلفه من المحترم الاستاذ النشط ياسر خليل حفظه الله استدعاء بمعيارين من الخارج3.rar ==================== '=========================== 'هذا الكود للمحترم النابغه ياسر خليل 'الهدف من الكود هو استدعاء بشرطين من صفحه الاكسيل 'وكذلك الاستدعاء بدون شرط 'وقد تم التنويه داخل الكود عن السطر المسئول 'تم هذا الكود في 15/2/2017 '================== Sub استدعاء_بمعيارين_من_الخارج() Dim arr As Variant Dim temp As Variant Dim cr As Variant Dim lr As Long Dim i As Long Dim j As Long Dim c As Long Dim ws As Worksheet Dim sh As Worksheet Dim myArray, targt, targt2 Set Main = Sheets("المصدر") Set sh = Sheets("Sheet2") targt = sh.Range("C1").Value & "*" targt2 = sh.Range("C2").Value & "*" 'targt = "ذك*" 'targt2 = "نا*" '= = = = = = = = = = = = ' شيت الهدف والمدى المطلوب مسحه sh.Range("B7:AE1000").ClearContents ' عدد الصفوف في ورقة المصدر lr = Main.Cells(Rows.Count, 1).End(xlUp).Row 'متغير اسم ورقة المصدرومدى البيانات بها arr = Main.Range("A7:EF" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) 'ارقام الاعمده المطلوب نقلها cr = Array(2, 3, 7, 8, 9, 11, 5, 135) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) '================== 'اذا أردت ان يستدعي بيانات بدون شرط 'ماعليك الا ان تجعل السطر البرمجي الموجود 'اسفل هذا السطر لا يعمل '================== 'رقم عمود الذي سيتم البحث فيه If arr(i, 5) Like targt & "*" _ And arr(i, 135) Like targt2 & "*" Then '================== temp(j, 1) = j For c = LBound(cr) To UBound(cr) temp(j, c + 2) = arr(i, cr(c)) Next c j = j + 1 '================== End If '================== Next i With sh 'خليه بدايه اللصق في شيت الهدف .Range("B7").Resize(j - 1, UBound(temp, 2)).Value = temp 'سطر لمسح التسطير .Range("B7:AJ" & Rows.Count).Borders.Value = 0 'سطر لاضافة التسطير .Range("B7:AJ" & .Cells(Rows.Count, 2).End(xlUp).Row).Borders.Value = 1 End With End Sub

بسم الله الرحمن الرحيم احبابنا في الله هذا كود خاص باستدعاء بيانات صفحه كامله الى صفحه اخرى مثلها في رؤوس العناوين ولكن بشرط - ( تصفيه بيانات ) - وهو خاص للمحترم الذي اكن له كل تقدير واحترام الاستاذ زيزو العجوز '================ Sub Trans_Data() 'الكود خاص بالمحترم زيزو العجوز 'يحفظه الله 'تم هذا الكود في 15/11/2017 'الهدف من الكود هو استدعاء صفحة كامله بشرط '================ Application.ScreenUpdating = False Application.Calculation = xlCalculationManual 'الاعلان عن اسماء الشيتات' Dim Main As Worksheet, sh As Worksheet ' الاعلان عن المصفوفتين Dim Arr As Variant, Temp As Variant '(i,j)الاعلان عن ابعاد المصفوفة الاولى ( p ) وعداد المصفوفة الثانية Dim i As Long, j As Long, p As Long ' الاعلان عن المتغير الذى سوف يتم العمل عليه Dim dep As String Set Main = Sheets("المصدر") Set sh = Sheets("الهدف") '======= ' محو البانات القديمة sh.Range("A7:CX" & Main.Range("B" & Rows.Count).End(xlUp).Row).ClearContents ' معيار الاختيار dep = sh.Range("C1").Value ' المصفوفة المصدر Arr = Main.Range("A7:CX" & Main.Range("B" & Rows.Count).End(xlUp).Row).Value ' ابعاد المصفوفة الهدف ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) ' طول المصفوفة المصدر For i = 1 To UBound(Arr, 1) 'رقم عمود الشرط If Arr(i, 101) Like "*" & dep & "*" Then 'If Arr(i, 101) = dep Then ' العداد لتحديد طول المصفوفة الهدف p = p + 1 ' عرض المصفوفة الهدف For j = 1 To UBound(Arr, 2) ' تعبئة المصفوفة الهدف من المصفوفة المصدر حسب الشرط Temp(p, j) = Arr(i, j) Next End If Next ' خليه البدايه لصفحه الهدف 'عرض البيانات المطلوبة If p > 0 Then sh.Range("A7").Resize(p, UBound(Temp, 2)).Value = Temp sh.Range("A7:CX" & Rows.Count).Borders.Value = 0 'سطر لاضافة التسطير sh.Range("A7:CX" & Cells(Rows.Count, 2).End(xlUp).Row).Borders _ .Weight = xlMedium ' .Weight = xlThin ' .Weight = xlMedium ' .Weight = xlThick Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub ========== استدعاء صفحة بشرط.rar