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

بسم الله الرحمان الرحيم و الصلاة و السلام على أشرف المرسلين أما بعد: سوف نقوم اليوم إن شاء الله بشرح أداة WebBrowser وأهم ما يتعلق بها من أوامر و أحداث و خصائص و إدخال و إخراج. و سوف يتم تقسيم هذا العمل إلى مجموعة حلقات نبدأ من الصفر حتى آخر نقطة نستطيع الوصول إليها إن شاء الله مع وضع مثال تطبيقي لكل حلقة. مقدمة: WebBrowser هي أداة تعمل عمل أي متصفح و هي مقترنة المتصفح الشهير Internet Explorer فهي تساعدك في تصفح المواقع من ناحية و التحكم في أكواد HTML وكل ما يرتبط بها من إدخال و استخراج بيانات من ناحية أخرى. ملاحظة: لتشغيل هذه الأداة بشكل جيد يجب تحديث المتصفح الشهير Internet Explorer إلى الإصدار 10 أو 11. مع العلم أن ونداوز 10 به الإصدار 11 الحلقة الأولى: أكواد التصفح سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التصفح و التنقل داخل الأداة. 1- كود فتح صفحة موقع: WebBrowser3 هو اسم الأداة داخل النموذج Me.WebBrowser3.Navigate ("رابط الصفحة كامل") 2- كود فتح صفحة فارغة: Me.WebBrowser3.Navigate ("about:blank") 3- كود الرجوع للصفحة السابقة: Me.WebBrowser3.GoBack 4- كود الإنتقال للصفحة التالية: Me.WebBrowser3.GoForward 5- كود إعادة تحميل الصفحة: Me.WebBrowser3.Refresh 6- كود إيقاف تحميل الصفحة: Me.WebBrowser3.Stop 7- كود إستخراج رابط الصفحة الحالية: MsgBox Me.WebBrowser3.Document.url و هذا مثال لما تم ذكره في هذه الحلقة webbroser.rar

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

جرب المرفق Database751.accdb هههههه اخي احمد نفس الفكرة بعد التحديث للحقل [نص0] = Format([نص0], "00/00/0000")

انتظرت ردك اخي الكريم فان كنت تقصد تحديد الاسم الاول في القائمة عن الضغط على الزر فاليك الامر التالي Me.txtliste3.Selected(0) = True تحياتي

جرب هذا الكود Option Explicit Sub give_data() Dim ARR_P, P As Worksheet, D As Worksheet Dim MY_RG As Range, MY_NAME$, R%, i% ARR_P = Array(4, 6, 9, 2, 16, 15, 17, 13, 14, 7, 8, 3, 18, 19) Set P = Sheets("Principal"): Set D = Sheets("DATA") P.Cells(7, "C").Resize(14) = vbNullString MY_NAME = P.Range("A3") Set MY_RG = D.Range("B3").CurrentRegion If MY_RG.Columns("E").Find(MY_NAME, lookat:=1) Is Nothing Then Exit Sub R = MY_RG.Columns("E").Find(MY_NAME, lookat:=1).Row For i = 0 To UBound(ARR_P) P.Cells(7, "C").Offset(i).Value = D.Cells(R, ARR_P(i)) Next Erase ARR_P End Sub الملف مرفق Data_base.xlsm

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

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

ربما هذا هو المطلوب fayz.rar

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

اخي @rey360 اذا كان فهمي لطلبك صحيح فان الاستاذ محمد اعطاك حل صحيح جرب الملف المرفق test(5).accdb

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

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

أشكرك أخى @rey360 موقع رهيب فعلا

السلام عليكم أستاذ أحمد الفلاحجى ما اسم الكتاب؟ أما بنسبة للاستاذ عبد الفتاح كيرة فهذا الموقع يعطيك الكثير من الكتب بالانجليزية أرجو أن ينفعك https://b-ok.cc/s/sql

وعليكم السلام اخي مصطفى اليك الملف وبه الدالة المطلوبة 444+.xls

السلام عليكم جرب المرفق لعل فيه ما تريد بعد تعديل طفيف على كود الأخ حسين مامون... TEST_2.xls

الاخوة اعضاء المنتدى العظيم بمناسبة تجديد المنتدى بثوبه الجديد نتعرف على موضوع الدوال بطريقة بسيطة تكملة لموضوع كيفية تصميم شيت بالاكسل الذى تم تنفيذه سابقا ارجو ان ينال رضاكم الدوال الدوال هى أوامر تقوم بتنفيذ مهام معينة وتتم كتابتها داخل الخلايا المختلفة لورقة العمل ويمكن تقسيم الدوال الى ست مجموعات كما يلى 1 الدوال العامة 2 الدوال المالية 3 الدوال الرياضية 4 الدوال الحرفية 5 الدوال الخاصة بالتاريخ والوقت 6 دوال قاعدة البيانات تعال معا نتعرف على كيفية البحث عن الدوال المختلفة الموجودة بالاكسل كيفية استخراج الدالة.rar

الحل استبدل الماكروات الى هذه Option Explicit Sub Edit_data() Dim Source_rg As Range Dim Find_rg As Range Dim r# Union(Range("b8:l8"), Range("c9:l9")).ClearContents Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("D6"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Source_rg.Find(Me.Range("d6")).Row With Me.Range("b8") .Value = Cells(r, 2): .Offset(, 1) = Cells(r, 3): .Offset(, 2) = Cells(r, 4) .Offset(, 3) = Cells(r, 5): .Offset(, 4) = Cells(r, 6): .Offset(, 5) = Cells(r, 7) .Offset(, 6) = Cells(r, 8): .Offset(, 7) = Cells(r, 9): .Offset(, 8) = Cells(r, 10) .Offset(, 9) = Cells(r, 11): .Offset(, 10) = Cells(r, 12) .Offset(1, 1) = Cells(r, 13) End With End Sub '+++++++++++++++++++++++++++++++++++++++++++ Sub ADD_data() Dim Source_rg As Range Dim Find_rg As Range Dim r# Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("d2"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Find_rg.Row '======================================== With Me.Range("b4") Cells(r, 2) = .Value: Cells(r, 3) = .Offset(, 1): Cells(r, 4) = .Offset(, 2) Cells(r, 5) = .Offset(, 3): Cells(r, 6) = .Offset(, 4): Cells(r, 7) = .Offset(, 5) Cells(r, 8) = .Offset(, 6): Cells(r, 9) = .Offset(, 7): Cells(r, 10) = .Offset(, 8) Cells(r, 11) = .Offset(, 9): Cells(r, 12) = .Offset(, 10): Cells(r, 13) = .Offset(1, 1) End With End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub Ta3dil() Dim Source_rg As Range Dim Find_rg As Range Dim r# Union(Range("B4:L4"), Range("C5:L5")).ClearContents Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("D2"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Source_rg.Find(Me.Range("D2")).Row With Me.Range("b4") .Value = Cells(r, 2): .Offset(, 1) = Cells(r, 3): .Offset(, 2) = Cells(r, 4) .Offset(, 3) = Cells(r, 5): .Offset(, 4) = Cells(r, 6): .Offset(, 5) = Cells(r, 7) .Offset(, 6) = Cells(r, 8): .Offset(, 7) = Cells(r, 9): .Offset(, 8) = Cells(r, 10) .Offset(, 9) = Cells(r, 11): .Offset(, 10) = Cells(r, 12) .Offset(1, 1) = Cells(r, 13) End With End Sub اضافة عبارة LookAt:=1 الى كل العبارات التي تحتوي على Set Find_rg الملف من جديد T-2019_Salim_new.xlsm

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

اتفضلى محاوله منى على قدى بس عملتها عن طريق زر اضفت زرين واحد لوضع العلامه وواحد للالغاء بالتوفيق yn.accdb

بالتوفيق اخي والشكر لله سبحانه

وعليكم السلام 🙂 نعم يمكن ، وتفتح نموذج معين ، وتعمل له تصفية ، وللقراءة فقط 🙂 يعني تعمل فيه اللي تريد 🙂 اقتطعت هذا الكود من احد برامجي : Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click Dim appAccess As Object Dim DB_Path As String Dim myWhere As String 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = "\\Managing_1\h\Personal\FE\Personal_FE.accdb" appAccess.OpenCurrentDatabase (DB_Path) myWhere = "[Full_Name]='" & Me.frm_1_All!Full_Name & "'" myWhere = myWhere & " And [Relation]<>'زوجة'" myWhere = myWhere & " And [Relation]<>'زوج'" appAccess.DoCmd.OpenForm "sfrm_Family", , , myWhere, acFormReadOnly appAccess.Visible = True appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

شكرا لك أستاذ kha9009lid وشكرا للاستاذ محمد ابوعبد الله على كل ماقمتم به أرجو أن يكون في ميزان حسناتكم test(5).accdb

هنا بدايات للموضوع ولكن للأسف لم يستكمل .....

شكرا لردك اخي الكريم بالضبط ما ابحث عنه هو اكواد xml

أرجو من أساتذة الكرام أن يساعدونا أريد استبدال التحديد اليدوي في قائمة الاسماء txtliste3 بتحديد أوتوتيكي بشرط أن يكون الاسم الذي في أعلى القائمة كما أنا زر valider به هذا الكود On Error Resume Next Dim db As DAO.Database Dim rs As Recordset Set db = CurrentDb Set rs = db.OpenRecordset("SELECT * FROM Clients WHERE idClient=" & Me.txtliste3, dbOpenDynaset) If Not rs.EOF Then rs.MoveFirst Form_f_historiquefacture.Texte23 = rs!idClient rs.Close Set rs = Nothing db.Close Set db = Nothing DoCmd.Close acForm, Me.Name DoCmd.Requery الذي يمكن من الاخذ الاسم المحدد من القائمة txtliste3 الى Texte23 في الفورم f_historiquefacture كل ما أريدوه هو أن يتم تحديد الاسم أعلى القائمة أوتماتيكيا بدون الحاجة الى تحديده يدويا وشكرا

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

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

تمام ان شاء الله يكفيك ان تضع هذا الامر فقط Texte2 = Me.txtliste3.Column(1) تحياتي

وعليكم السلام اخى اسم الكتاب John Wiley & Sons - SQL for Dummies, 5th Edition قد تم حذفه لحقوق الملكيه ولم اعلم بها وقدنبهنى بها اخى واستاذى جعفر وجزاك الله خيرا على مشاركتك ايانا الموقع ولو فى حاجه بالعربى يبقى افضل تقبل تحياتى

أستاذ مصطفى كمال متولى أين الضغط على الإعجاب ؟! 💙

شكرا جزيلا و بارك الله فيك

شكر اخي بن عليه ليس المطلوب لكن تعديلك ساعدني اضفت هذا السطر Range("E5").Value = Range("E5").Value + 1 حتى يخزن في كل مرة رقم جديد

عليكم السلام جرب المرفق فيه كود انشاء مجلد في :D وهذا ان لم يجده اسم المجلد myDOSER ويحول المدى المحدد في الكود الى PDF TEST .xls

جرب الملف التالي Annual_Repport.xls

الشكر لله اخي zero111330566

شكرا جدا لحضرتك استاذ سليم ربنا يجازيك خيرا

مشاركة مع أخي خالد ..... barna.accdb

جرب المرفق اختار تاريخ البداية وعدد الايام Database74.accdb

لا لزوم للحلقات التكراري في هذه الجالة يكفي هذا الكود البسيط Sub Fill_Empty() Range("B2:F6").SpecialCells(4) = "/" End Sub

تفضل الملف جاهز MAGAZIN.xlsx

السلام عليكم اولا : لماذا لاتجعل القيمة الافتراضية للحقل = صفر ولا تحتاج الى استعلام تحديث ثانيا : تفضل اخي الكريم عملت لك استعلام تحديث بالملف يجعل القيم الفارغة بالجدول = صفر اعلمنا النتائج aceess55.rar

السلام عليكم اخي العزيز اصبح التركيز (SetFocus) على هذا الحقل ويمكن تغييره بعدة طرق منها: 1- عن طريق ترتيب الجدولة. اضغط بزر الماوس الايمن في مكان فارغ بالنموذج في طريقة عرض التصميم(كما في الصور) : 2- عن طريق الكود البرمجي. كما في الملف المرفق (يوجد نموذجين بالملف احدهما افتراضي والاخر برمجي) Me.[اسم الحقل].SetFocus test.rar

أقسم بالله لسة فاتح النت حالاً ...☺️ خالص شكري وتقديري للجميع أستاذ عبد الله أنا عاجز عن الشكر تسلم أيدك ويارب دايماً بالصحة والخير والسعادة

أنت رائع أستاذي جعفر

وعليكم السلام الاربع اسطر الاخيرة: 2. نعمل الاستعلام qry_NewQry من جملة mySQL_Union ، 3. نصدر بيانات الاستعلام الى D:\Test\abc.xls ، 4. نحذف الاستعلام. Private Sub cmd_Training_Records_Click() mySQL1 = "SELECT TOP " & Forms!Q1!iSchool & " الوقت, الاسم, الجهة, الدورة" mySQL1 = mySQL1 & " FROM tbl_Training" mySQL1 = mySQL1 & " WHERE الجهة = 'مدرسة' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL1 = mySQL1 & " ORDER BY الوقت" 'Debug.Print mySQL1 mySQL2 = "SELECT TOP " & Forms!Q1!iAdmin & " الوقت, الاسم, الجهة, الدورة" mySQL2 = mySQL2 & " FROM tbl_Training" mySQL2 = mySQL2 & " WHERE الجهة = 'إدارة' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL2 = mySQL2 & " ORDER BY الوقت" 'Debug.Print mySQL2 mySQL3 = "SELECT TOP " & Forms!Q1!iOffice & " الوقت, الاسم, الجهة, الدورة" mySQL3 = mySQL3 & " FROM tbl_Training" mySQL3 = mySQL3 & " WHERE الجهة = 'مكتب' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL3 = mySQL3 & " ORDER BY الوقت" 'Debug.Print mySQL3 mySQL_union = mySQL1 & " union all " & mySQL2 & " union all " & mySQL3 'Debug.Print mySQL_union Me.f1.Form.RecordSource = mySQL_union Me.f1.Form.OrderBy = "الجهة, الوقت" Me.f1.Form.OrderByOn = True Dim qdf As QueryDef Set qdf = CurrentDb.CreateQueryDef("qry_NewQry", mySQL_union) DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "qry_NewQry", "D:\Test\abc.xls" CurrentDb.QueryDefs.Delete "qry_NewQry" End Sub جعفر

وعليكم السلام هذا الزر هو الذي قام بتنظيم الدورات ونقلها إلى حقل واحد. لاستخدامه: 1. أعمل نسخه من جدول المتقدمين، واسميه tbl_Training ، 2. غيّر اسم الحقل دورة1 الى دورة ، 3. اضغط على هذا الزر ، 4. ارجع الى الجدول tbl_Training ، سترى السجلات الجديدة، وهي نسخة من الدورات دورة2 الى دورة5 تم تصفيفها في حقل دورة، مع الأخذ في الاعتبار التاريخ والأيام و الجهة ، 5. احذف حقول دورة2 الى دورة5. بعد تحويل الجدول بهذه الطريقة، ينتهي دور النموذج، ولا تستعمله مرة ثانية. جعفر

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

وعليكم السلام اولا وقبل كل شيء ، يجب عليك تغيير تصميم جدول "المتقدمين" (حاليا تصميمه يناسب الاكسل) ، حتى يكون بطريقة قواعد البيانات الصحيحة ، والذي سيوفر عليك الكثير من الوقت لاحقا ، لذا عملت لك التعديل في الجدول tbl_Training . انت محتاج تعمل استعلام لكل جهة (يعني 3 استعلامات) ، ثم تستعمل الامر Union لتجمع الاستعلامات الثلاث في استعلام واحد ، ولكن المشكلة هي العدد المطلوب ، فلا يمكننا ان نجعل العدد رقم متغير في الاستعلام ، وهو ما يشار الى بـ TOP n (اذا العدد معروف مسبقا ، فالاستعلامات الثلاث سهله ، ثم نعمل استعلام Union يجمعها) ، لذا وجب علينا ان نعمل الاستعلامات في الكود Private Sub cmd_Training_Records_Click() mySQL1 = "SELECT TOP " & Forms!Q1!iSchool & " الوقت, الاسم, الجهة, الدورة" mySQL1 = mySQL1 & " FROM tbl_Training" mySQL1 = mySQL1 & " WHERE الجهة = 'مدرسة' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL1 = mySQL1 & " ORDER BY الوقت" 'Debug.Print mySQL1 mySQL2 = "SELECT TOP " & Forms!Q1!iAdmin & " الوقت, الاسم, الجهة, الدورة" mySQL2 = mySQL2 & " FROM tbl_Training" mySQL2 = mySQL2 & " WHERE الجهة = 'إدارة' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL2 = mySQL2 & " ORDER BY الوقت" 'Debug.Print mySQL2 mySQL3 = "SELECT TOP " & Forms!Q1!iOffice & " الوقت, الاسم, الجهة, الدورة" mySQL3 = mySQL3 & " FROM tbl_Training" mySQL3 = mySQL3 & " WHERE الجهة = 'مكتب' And الدورة ='" & [Forms]![Q1]![T1] & "'" mySQL3 = mySQL3 & " ORDER BY الوقت" 'Debug.Print mySQL3 mySQL_union = mySQL1 & " union all " & mySQL2 & " union all " & mySQL3 'Debug.Print mySQL_union Me.f1.Form.RecordSource = mySQL_union Me.f1.Form.OrderBy = "الجهة, الوقت" Me.f1.Form.OrderByOn = True End Sub . ويكون الاستعلام الاخير هو مصدر بيانات النموذج الفرعي . جعفر 837.الدورات.accdb.zip